Peppermint
/
debian-cd-clone
mirror of https://salsa.debian.org/images-team/debian-cd.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Major re-work of sort_deps to deal with versioned dependencies 

Changes:

Use/parse output from a newer version of apt so that "apt-cache
depends" will include version information on dependencies.

All tracking of packages now include versions, so we pass around
hashes of {package name, comparison op, version} everywhere instead of
simply passing package names as strings.

WIP for now; apt-cache is likely to change format before we ship
this...
This commit is contained in:
Steve McIntyre 2012-09-25 22:44:08 +00:00
parent 8fdc5da94e
commit 02b108335b
1 changed files with 426 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

598
tools/sort_deps
View File

@ -13,8 +13,10 @@
# per-disc basis now. # per-disc basis now.
use strict; use strict;
use Data::Dumper;
use Dpkg::Version;
my $list = shift; my $listfile = shift;
my $nonfree = read_env('NONFREE', 0); my $nonfree = read_env('NONFREE', 0);
my $extranonfree = read_env('EXTRANONFREE', 0); my $extranonfree = read_env('EXTRANONFREE', 0);
@ -34,7 +36,21 @@ my $dir = "$ENV{'TDIR'}/$ENV{'CODENAME'}";
my $force_unstable_tasks = read_env('FORCE_SID_TASKSEL', 0); my $force_unstable_tasks = read_env('FORCE_SID_TASKSEL', 0);
my $tasks_packages = read_env('TASKS_PACKAGES', my $tasks_packages = read_env('TASKS_PACKAGES',
"$ENV{'MIRROR'}/dists/sid/main/binary-$ENV{'ARCH'}/Packages.gz"); "$ENV{'MIRROR'}/dists/sid/main/binary-$ENV{'ARCH'}/Packages.gz");
my @output; my @output = ();
# Borrowed from the internals of apt. Ewwww.
# enum DepCompareOp {Or=0x10,NoOp=0,LessEq=0x1,GreaterEq=0x2,Less=0x3,
# Greater=0x4,Equals=0x5,NotEquals=0x6};
my $DEPCOMPARE_OR = 16;
my $DEPCOMPARE_NOP = 0;
my $DEPCOMPARE_LE = 1;
my $DEPCOMPARE_GE = 2;
my $DEPCOMPARE_LT = 3;
my $DEPCOMPARE_GT = 4;
my $DEPCOMPARE_EQ = 5;
my $DEPCOMPARE_NE = 6;
my @DEPCOMPARE_TEXT = ("", "<=", ">=", "<<", ">>", "=", "!=");
$| = 1; # Autoflush for debugging $| = 1; # Autoflush for debugging
@ -68,7 +84,7 @@ msg(0, "Running sort_deps to sort packages for $arch:\n");
msg(1, "====================================================================== msg(1, "======================================================================
Here are the settings you've chosen for making the list: Here are the settings you've chosen for making the list:
Architecture: $arch Architecture: $arch
List of prefered packages: $list List of prefered packages: $listfile
Output file: $dir/packages.$arch Output file: $dir/packages.$arch
"); ");
msg(1, "Complete selected packages with all the rest: "); msg(1, "Complete selected packages with all the rest: ");
@ -150,7 +166,7 @@ foreach (keys %excluded) {
close (STATS); close (STATS);
# Browse the list of packages to include # Browse the list of packages to include
my ($output_size, $size) = (0, 0, 0); my ($output_size, $size) = (0, 0);
my %cds; my %cds;
# Generate a dependency tree for each package # Generate a dependency tree for each package
@ -171,9 +187,11 @@ while (@list) {
if ($res[$i] !~ m/^(\S+)\s*$/) { if ($res[$i] !~ m/^(\S+)\s*$/) {
msg(0, "UNEXPECTED: Line `$res[$i]' while parsing " . msg(0, "UNEXPECTED: Line `$res[$i]' while parsing " .
"end of deptree from '$p'\n"); "end of deptree from '$p'\n");
die "sort_deps failed! :-(\n";
} }
$p = lc $1; $i++; $p = lc $1;
msg(2, " Dependency tree of `$p' ...\n"); $i++;
msg(2, " Dependency tree of `$p' ...\n");
read_depends (\$i, \@res, $p); read_depends (\$i, \@res, $p);
} }
@ -200,7 +218,7 @@ msg(0, " S/R/I/B packages take $output_size bytes\n");
# Now start to look for packages wanted by the user ... # Now start to look for packages wanted by the user ...
msg(0, " Adding the rest of the requested packages\n"); msg(0, " Adding the rest of the requested packages\n");
open (LIST, "< $list") || die "Can't open $list : $!\n"; open (LIST, "< $listfile") || die "Can't open $listfile : $!\n";
while (defined($_=<LIST>)) { while (defined($_=<LIST>)) {
chomp; chomp;
next if m/^\s*$/; next if m/^\s*$/;
@ -218,9 +236,9 @@ while (defined($_=<LIST>)) {
# nevertheless ... this may be removed once the udebs have a # nevertheless ... this may be removed once the udebs have a
# better depencency system # better depencency system
if ($packages{$_}{"IsUdeb"}) { if ($packages{$_}{"IsUdeb"}) {
add_to_output($packages{$_}{"Size"}, [$_]); add_to_output($_);
} else { } else {
add_package ($_, ! $norecommends, ! $nosuggests); add_package ($_, ! $norecommends, ! $nosuggests);
} }
} }
close LIST; close LIST;
@ -270,7 +288,7 @@ if ($extranonfree and (! $nonfree))
# include and if COMPLETE=0 there's a chance that the package # include and if COMPLETE=0 there's a chance that the package
# will not get included in any CD ... so I'm checking the complete # will not get included in any CD ... so I'm checking the complete
# list again # list again
open (LIST, "< $list") || die "Can't open $list : $!\n"; open (LIST, "< $listfile") || die "Can't open $listfile : $!\n";
while (defined($_=<LIST>)) { while (defined($_=<LIST>)) {
chomp; chomp;
next if m/^\s*$/; next if m/^\s*$/;
@ -364,17 +382,48 @@ sub parse_package {
} }
} }
sub dump_depend {
my $tmpin = shift;
my %d;
my $ret = "";
if ("ARRAY" eq ref($tmpin)) {
my @array = @{$tmpin};
foreach (@array) {
%d = %$_;
$ret .= $d{"Package"};
if ($d{"CmpOp"} > $DEPCOMPARE_NOP &&
$d{"CmpOp"} <= $DEPCOMPARE_NE) {
$ret .= " (" . $DEPCOMPARE_TEXT[$d{"CmpOp"}] . " " . $d{"Version"} . ")";
}
$ret .= " ";
}
} elsif ("HASH" eq ref($tmpin)) {
%d = %$tmpin;
$ret .= $d{"Package"};
if ($d{"CmpOp"} > $DEPCOMPARE_NOP &&
$d{"CmpOp"} <= $DEPCOMPARE_NE) {
$ret .= " (" . $DEPCOMPARE_TEXT[$d{"CmpOp"}] . " " . $d{"Version"} . ")";
}
} else {
die "dump_depend: $tmpin is neither an array nor a hash!\n";
}
return $ret;
}
sub read_depends { sub read_depends {
my $i = shift; # Ref my $i = shift; # Ref
my $lines = shift; # Ref my $lines = shift; # Ref
my $pkg = shift; # string my $pkg = shift; # string
my $types = "(?:Pre)?Depends|Suggests|Recommends|Replaces|Conflicts|Breaks|Enhances"; my $types = "(?:Pre)?Depends|Suggests|Recommends|Replaces|Conflicts|Breaks|Enhances";
my (@dep, @rec, @sug); my (@dep, @rec, @sug);
my ($type, $or, $elt); my ($type, $or);
while ($lines->[$$i] =~ m/^\s([\s\|])($types):/) { while ($lines->[$$i] =~ m/^\s([\s\|])($types):/) {
$type = $2; $or = $1; $type = $2; $or = $1;
# Get rid of replaces and conflicts ... # Get rid of replaces, conflicts and any other fields we don't
# care about...
if (($type eq "Replaces") or if (($type eq "Replaces") or
($type eq "Conflicts") or ($type eq "Conflicts") or
($type eq "Breaks") or ($type eq "Breaks") or
@ -385,19 +434,51 @@ sub read_depends {
} }
next; next;
} }
my $out_type = $type;
$out_type =~ s/^Pre//; # PreDepends are like Depends for me
# Check the kind of depends : or, virtual, normal # Check the kind of depends : or, virtual, normal
if ($or eq '|') { if ($or eq '|') {
$elt = read_ordepends ($i, $lines); my $elt = read_ordepends ($i, $lines);
foreach my $t (@$elt) {
msg(1, " " . dump_depend($t) . " (OR)\n");
}
push @{$packages{$pkg}{$out_type}}, $elt;
} elsif ($lines->[$$i] =~ m/^\s\s$type: <([^>]+)>/) { } elsif ($lines->[$$i] =~ m/^\s\s$type: <([^>]+)>/) {
$elt = read_virtualdepends ($i, $lines); my $elt = read_virtualdepends ($i, $lines);
} elsif ($lines->[$$i] =~ m/^\s\s$type: (\S+)/) { foreach my $t (@$elt) {
$elt = $1; $$i++; msg(1, " " . dump_depend($t) . " <virt>\n");
}
push @{$packages{$pkg}{$out_type}}, $elt;
} elsif ($lines->[$$i] =~ m/^\s\s$type: (\S+)( \((\d+) (\S+)\))*/) {
my %elt;
$elt{"Package"} = $1;
if (defined $2) {
$elt{"CmpOp"} = $3 & 15;
$elt{"Version"} = $4;
} else {
$elt{"CmpOp"} = $DEPCOMPARE_NOP;
$elt{"Version"} = "";
}
msg(1, " " . dump_depend(\%elt) . "\n");
push @{$packages{$pkg}{$out_type}}, \%elt;
$$i++;
# Special case for packages providing not # Special case for packages providing not
# truely virtual packages # truly virtual packages
if ($lines->[$$i] =~ m/^\s{4}/) { if ($lines->[$$i] =~ m/^\s{4}/) {
$elt = [ $elt ]; while ($lines->[$$i] =~ m/\s{4}(\S+)( \((\d+) (\S+)\))*/) {
while ($lines->[$$i] =~ m/\s{4}(\S+)/) { $elt{"Package"} = $1;
push @{$elt}, $1; if (defined $2) {
$elt{"CmpOp"} = $3 & 15;
$elt{"Version"} = $4;
} else {
$elt{"CmpOp"} = $DEPCOMPARE_NOP;
$elt{"Version"} = "";
}
msg(1, " " . dump_depend(\%elt) . "\n");
push @{$packages{$pkg}{$out_type}}, \%elt;
$$i++; $$i++;
} }
} }
@ -407,20 +488,87 @@ sub read_depends {
msg(0, " ", $lines->[$_]); msg(0, " ", $lines->[$_]);
} }
} }
$type =~ s/^Pre//; # PreDepends are like Depends for me
next if dep_satisfied($elt);
push @{$packages{$pkg}{$type}}, $elt;
} }
} }
# Big matrix of tests. Check to see if the available version of a
# package matches what we're requesting in a dependency relationship
sub check_versions {
my $wanted = shift;
my $op = shift;
my $available = shift;
# Trivial check - if we don't care about versioning, anything will
# do!
if ($op == $DEPCOMPARE_NOP) {
return 1;
}
# Ask the dpkg perl code to compare the version strings
my $comp = version_compare($available, $wanted);
if ($op == $DEPCOMPARE_LE) {
if ($comp == -1 || $comp == 0) {
return 1;
}
} elsif ($op == $DEPCOMPARE_GE) {
if ($comp == 0 || $comp == 1) {
return 1;
}
} elsif ($op == $DEPCOMPARE_LT) {
if ($comp == -1) {
return 1;
}
} elsif ($op == $DEPCOMPARE_GT) {
if ($comp == 1) {
return 1;
}
} elsif ($op == $DEPCOMPARE_EQ) {
if ($comp == 0) {
return 1;
}
} elsif ($op == $DEPCOMPARE_NE) {
if ($comp == -1 || $comp == 1) {
return 1;
}
}
# else
return 0;
}
# Check if a specific dependency package is installed already
sub dep_pkg_included {
my $p = shift;
my %d = %$p;
my $pn = $d{"Package"};
if ($included{$pn}) {
if (check_versions($d{"Version"}, $d{"CmpOp"}, $packages{$pn}{"Version"})) {
msg(1, " $pn is included already, acceptable version " . $packages{$pn}{"Version"} . "\n");
return 1;
} else {
msg(1, " $pn is included already, but invalid version " . $packages{$pn}{"Version"} . "\n");
}
}
# else
return 0;
}
# Check to see if a dependency is satisfied, either a direct
# dependency or any one of an OR array
sub dep_satisfied { sub dep_satisfied {
my $p = shift; my $p = shift;
if (ref $p) {
if ("ARRAY" eq ref $p) {
foreach (@{$p}) { foreach (@{$p}) {
return 1 if $included{$_}; if (dep_pkg_included($_)) {
return 1;
}
} }
} elsif ("HASH" eq ref $p) {
return dep_pkg_included($p);
} else { } else {
return $included{$p}; die "dep_satisfied: $p is neither a hash nor an array!\n";
} }
return 0; return 0;
} }
@ -429,11 +577,21 @@ sub read_ordepends {
my $i = shift; my $i = shift;
my $lines = shift; my $lines = shift;
my @or = (); my @or = ();
my ($val,$dep, $last) = ('','',0); my ($val, $dep, $last) = ('','',0);
my ($op, $version);
chomp $lines->[$$i];
while ($lines->[$$i] while ($lines->[$$i]
=~ m/^\s([\s\|])((?:Pre)?Depends|Suggests|Recommends): (\S+)/) { =~ m/^\s([\s\|])((?:Pre)?Depends|Suggests|Recommends): (\S+)( \((\d+) (\S+)\))*/) {
$val = $3; $val = $3;
if (defined $4) {
$op = $5 & 15;
$version = $6;
} else {
$op = $DEPCOMPARE_NOP;
$version = "";
}
$last = 1 if $1 ne '|'; #Stop when no more '|' $last = 1 if $1 ne '|'; #Stop when no more '|'
if ($val =~ m/^<.*>$/) { if ($val =~ m/^<.*>$/) {
$dep = read_virtualdepends ($i, $lines); $dep = read_virtualdepends ($i, $lines);
@ -443,11 +601,24 @@ sub read_ordepends {
push @or, $dep; push @or, $dep;
} }
} else { } else {
push @or, $val; $$i++; my %elt;
# Hack for packages providing not a truely $elt{"Package"} = $val;
$elt{"CmpOp"} = $op;
$elt{"Version"} = $version;
push @or, \%elt;
$$i++;
# Hack for packages providing not a truly
# virtual package # virtual package
while ($lines->[$$i] =~ m/^\s{4}(\S+)/) { while ($lines->[$$i] =~ m/^\s{4}(\S+)( \((\d+) (\S+)\))*/) {
push @or, $1; $elt{"Package"} = $1;
if (defined $2) {
$elt{"CmpOp"} = $3 & 15;
$elt{"Version"} = $4;
} else {
$elt{"CmpOp"} = $DEPCOMPARE_NOP;
$elt{"Version"} = "";
}
push @or, \%elt;
$$i++; $$i++;
} }
} }
@ -469,14 +640,28 @@ sub read_virtualdepends {
$$i++ $$i++
} }
# Now look at the alternatives on the following lines # Now look at the alternatives on the following lines
while ($lines->[$$i] =~ m/^\s{4}(\S+)/) { while ($lines->[$$i] =~ m/^\s{4}(\S+)( \((\d+) (\S+)\))*/) {
push @or, $1; my %elt;
$elt{"Package"} = $1;
if (defined $2) {
$elt{"CmpOp"} = $3 & 15;
$elt{"Version"} = $4;
} else {
$elt{"CmpOp"} = $DEPCOMPARE_NOP;
$elt{"Version"} = "";
}
push @or, \%elt;
$$i++; $$i++;
} }
if (@or) { if (@or) {
return \@or; return \@or;
} else { } else {
return $virtual; my %elt;
$elt{"Package"} = $virtual;
$elt{"CmpOp"} = $DEPCOMPARE_NOP;
$elt{"Version"} = "";
push @or, \%elt;
return \@or;
} }
} }
@ -507,7 +692,7 @@ sub add_package {
return; return;
} }
msg(3, " \@dep before checklist = @dep\n"); msg(3, " \@dep before checklist = " . dump_depend(\@dep) . "\n");
# Check if all packages are allowed (fail if one cannot) # Check if all packages are allowed (fail if one cannot)
($ok, $reasons) = check_list (\@dep, 1); ($ok, $reasons) = check_list (\@dep, 1);
@ -517,24 +702,26 @@ sub add_package {
return; return;
} }
msg(3, " \@dep after checklist = @dep\n"); msg(3, " \@dep after checklist = " . dump_depend(\@dep) . "\n");
if ($add_rec) { if ($add_rec) {
#TODO: Look for recommends (not yet included !!) #TODO: Look for recommends (not yet included !!)
add_recommends (\@dep, $p); add_recommends (\@dep, $p);
# Check again but doesn't fail if one of the package cannot be msg(3, " \@dep after add_recommends = " . dump_depend(\@dep) . "\n");
# installed, just ignore it (it will be removed from @dep) # Check again but doesn't fail if one of the package cannot be
# installed, just ignore it (it will be removed from @dep)
($ok, $reasons) = check_list (\@dep, 0); ($ok, $reasons) = check_list (\@dep, 0);
if (not $ok) { if (not $ok) {
msg(0, "UNEXPECTED: It shouldn't fail here !\n"); msg(0, "UNEXPECTED: It shouldn't fail here !\n");
return; return;
} }
msg(3, " \@dep after checklist2 = @dep\n"); msg(3, " \@dep after checklist2 = " . dump_depend(\@dep) . "\n");
} }
if ($add_sug) { if ($add_sug) {
#TODO: Look for suggests (not yet included !!) #TODO: Look for suggests (not yet included !!)
add_suggests (\@dep, $p); add_suggests (\@dep, $p);
msg(3, " \@dep after add_suggests = " . dump_depend(\@dep) . "\n");
# Check again but doesn't fail if one of the package cannot be # Check again but doesn't fail if one of the package cannot be
# installed, just ignore it (it will be removed from @dep) # installed, just ignore it (it will be removed from @dep)
($ok, $reasons) = check_list (\@dep, 0); ($ok, $reasons) = check_list (\@dep, 0);
@ -542,63 +729,77 @@ sub add_package {
msg(0, "UNEXPECTED: It shouldn't fail here !\n"); msg(0, "UNEXPECTED: It shouldn't fail here !\n");
return; return;
} }
msg(3, " \@dep after checklist3 = @dep\n"); msg(3, " \@dep after checklist3 = " . dump_depend(\@dep) . "\n");
} }
# All packages are ok, now check for the size issue # All packages are ok, now list them out and add sizes
$size = get_size (\@dep); foreach my $t (@dep) {
add_to_output ($size, \@dep); my %t = %$t;
my $pkgname = $t{"Package"};
add_to_output($pkgname);
}
} }
sub accepted { sub accepted {
my $p = shift; my $p = shift;
return not $excluded{$p} if (exists $excluded{$p}); return not $excluded{$p} if (exists $excluded{$p});
# Return false for a non-existant package ... # Return false for a non-existent package ...
msg(1, "WARNING: $p cannot be accepted, it doesn't exist ...\n"); msg(1, "WARNING: $p cannot be accepted, it doesn't exist ...\n");
return 0; return 0;
} }
sub add_suggests { sub add_suggests {
my $list = shift; my $deps_list = shift;
my $pkg = shift; my $pkg = shift;
my @parents = ($pkg); my @parents = ($pkg);
my $p; # = shift; my $p; # = shift;
my @copy = @{$list}; # A copy is needed since I'll modify the array my @copy = @{$deps_list}; # A copy is needed since I'll modify the array
foreach $p (@copy) { foreach $p (@copy) {
add_missing($list, $packages{$p}{"Suggests"}, $p, 1, \@parents); my %t = %$p;
my $pkgname = $t{"Package"};
add_missing($deps_list, $packages{$pkgname}{"Suggests"}, \%t, 1, \@parents);
} }
} }
sub add_recommends { sub add_recommends {
my $list = shift; my $deps_list = shift;
my $pkg = shift; my $pkg = shift;
my @parents = ($pkg); my @parents = ($pkg);
my $p; # = shift; my $p; # = shift;
my @copy = @{$list}; # A copy is needed since I'll modify the array my @copy = @{$deps_list}; # A copy is needed since I'll modify the array
foreach $p (@copy) { foreach $p (@copy) {
add_missing($list, $packages{$p}{"Recommends"}, $p, 1, \@parents); my %t = %$p;
my $pkgname = $t{"Package"};
add_missing($deps_list, $packages{$pkgname}{"Recommends"}, \%t, 1, \@parents);
} }
} }
sub get_missing { sub get_missing {
my $p = shift; my $p = shift;
my @list = (); my @deps_list = ();
my @parents = (); my @parents = ();
my %t;
my $dep_text;
if (not add_missing (\@list, $packages{$p}{"Depends"}, $p, 0, \@parents)) { $t{"Package"} = $p;
$t{"CmpOp"} = $DEPCOMPARE_NOP;
$t{"Version"} = "";
if (not add_missing (\@deps_list, $packages{$p}{"Depends"}, \%t, 0, \@parents)) {
return (); return ();
} }
remove_entry($p, \@list); # Explicitly move the package itself to the end of the list,
push @list, $p; # i.e. *after* all its dependencies
return (@list); remove_entry(\%t, \@deps_list);
push @deps_list, \%t;
return (@deps_list);
} }
# Recursive function adding to the # Recursive function adding packages to our list
sub add_missing { sub add_missing {
my $list = shift; my $list = shift;
my $new = shift; my $new = shift;
@ -607,59 +808,92 @@ sub add_missing {
my $ok = 1; my $ok = 1;
my $soft_depend = shift; my $soft_depend = shift;
my $parents = shift; my $parents = shift;
my $pkgname;
my (%pkgin);
push(@{$parents}, $pkgin); if (ref $pkgin eq "HASH") {
%pkgin = %$pkgin;
} else {
die "add_missing passed a non-hash";
}
push(@{$parents}, $pkgin{"Package"});
#msg(3, " add_missing: parents atm @{$parents}\n"); #msg(3, " add_missing: parents atm @{$parents}\n");
# Check all dependencies # Check all dependencies
foreach (@{$new}) { foreach my $thisdep (@{$new}) {
if (ref) { my $textout = "";
my $textout = ""; $pkgname = $pkgin{"Package"};
foreach my $orpkg (@{$_}) {
$textout .= "$orpkg ";
}
msg(3, " $pkgin Dep: ( OR $textout) soft_depend $soft_depend\n");
} else {
msg(3, " $pkgin Dep: $_ soft_depend $soft_depend\n");
}
next if dep_satisfied ($_);
# If it's an OR
if (ref) {
my $or_ok = 0;
# Loop over each package in the OR
# We always add the first package in the OR to allow
# APT to figure out which is the better one to install
# for any combination of packages that have similar
# alternative dependencies, but in different order.
# Having the first alternative available should be good
# enough for all cases we care about.
# Minor tweak: check all the OR packages # Print out status
# up-front with no recursion. If *any* one of if ("ARRAY" eq ref($thisdep)) {
# them is already installed, it will do. $textout = "(OR ";
foreach my $pkg (@{$_}) { foreach my $orpkg (@{$thisdep}) {
if ($included{$pkg} or is_in ($pkg, $parents)) { $textout .= dump_depend($orpkg) . " ";
msg(3, " OR relationship already satisfied by $pkg\n"); }
$textout .= ")";
} elsif ("HASH" eq ref($thisdep)) {
$textout = dump_depend($thisdep);
} else {
die "add_missing: $thisdep should be an array or hash!\n";
}
msg(3, " $pkgname Dep: $textout soft_depend $soft_depend\n");
# Bail out early if we can!
if (dep_satisfied ($thisdep)) {
next;
}
# Still work to do...
# If it's an OR
if ("ARRAY" eq ref($thisdep)) {
my $or_ok = 0;
# First check all the OR packages up-front with no
# recursion. If *any* one of them is already installed, it
# will do.
foreach my $pkg (@{$thisdep}) {
my %t = %$pkg;
my $pkgname = $t{"Package"};
# Already installed?
if (dep_satisfied($pkg)) {
msg(3, " OR relationship already installed: " . dump_depend($pkg) . "\n");
$or_ok = 1; $or_ok = 1;
last; last;
} else {
msg(3, " $pkg not already installed\n");
} }
# Pulled in already somewhere above us in the
# depth-first search? (yes, we have to cope with
# circular dependencies here...)
if (is_in ($t{"Package"}, $parents) &&
check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pkgname}{"Version"})) {
msg(3, " OR relationship already satisfied by parent " . dump_depend($pkg) . "\n");
$or_ok = 1;
last;
}
# else
msg(3, " " . dump_depend($pkg) . " not already installed\n");
} }
# If we don't have any of the OR packages, # If we don't have any of the OR packages, then start
# then start again and try them in order # again and try them in order. We always add the first
# package in the OR to allow APT to figure out which is
# the better one to install for any combination of
# packages that have similar alternative dependencies, but
# in different order. Having the first alternative
# available should be good enough for all cases we care
# about.
if (not $or_ok) { if (not $or_ok) {
msg(3, " OR relationship not already satisfied, looking at alternatives in order\n"); msg(3, " OR relationship not already satisfied, looking at alternatives in order\n");
foreach my $pkg (@{$_}) {
next if not accepted ($pkg); foreach my $pkg (@{$thisdep}) {
# If the package is already included my %t = %$pkg;
# then don't worry my $pkgname = $t{"Package"};
if ($included{$pkg}) { if (not accepted($pkgname)) {
$or_ok = 1; next;
last;
} }
# Check we don't already have the package # Check we don't already have the package
if (is_in ($pkg, $list)) { if (is_in_dep_list($pkg, $list)) {
$or_ok = 1; $or_ok = 1;
last; last;
# Otherwise try to add it # Otherwise try to add it
@ -668,7 +902,7 @@ sub add_missing {
# package that is # package that is
# added successfully # added successfully
push (@{$list}, $pkg); push (@{$list}, $pkg);
if (add_missing ($list, $packages{$pkg}{"Depends"}, $pkg, $soft_depend, $parents)) { if (add_missing ($list, $packages{$pkgname}{"Depends"}, $pkg, $soft_depend, $parents)) {
$or_ok = 1; $or_ok = 1;
remove_entry($pkg, $list); remove_entry($pkg, $list);
push @{$list}, $pkg; push @{$list}, $pkg;
@ -681,52 +915,63 @@ sub add_missing {
} }
$ok &&= $or_ok; $ok &&= $or_ok;
if (not $ok) { if (not $ok) {
$pkgname = $pkgin{"Package"};
if ($soft_depend) { if ($soft_depend) {
msg(1, " $pkgin failed, couldn't satisfy OR dep (but it's a soft dep, so ignoring...)\n"); msg(1, " $pkgname failed, couldn't satisfy OR dep (but it's a soft dep, so ignoring...)\n");
$ok = 1; $ok = 1;
} else { } else {
msg(1, " $pkgin failed, couldn't satisfy OR dep\n"); msg(1, " $pkgname failed, couldn't satisfy OR dep\n");
} }
} }
# Else it's a simple dependency # Else it's a simple dependency
} else { } else {
msg(1, " Looking at adding $_ to satisfy dep\n"); my %t = %{$thisdep};
if (not exists $packages{lc $_}) { my $pt = dump_depend(\%t);
msg(1, " $_ doesn't exist...\n"); msg(1, " Looking at adding $pt to satisfy dep\n");
if (not exists $packages{lc $t{"Package"}}) {
msg(1, " $pt doesn't exist...\n");
if ($soft_depend) { if ($soft_depend) {
msg(1, " soft dep: $pkgin ok, despite missing dep on $_\n"); msg(1, " soft dep: $pkgname ok, despite missing dep on $pt\n");
$ok = 1; $ok = 1;
} else { } else {
msg(1, " $pkgin failed, couldn't satisfy dep on $_\n"); msg(1, " $pkgname failed, couldn't satisfy dep on $pt\n");
$ok = 0; $ok = 0;
last; last;
} }
} }
next if $included{lc $_}; # Already included, don't worry if (dep_satisfied(\%t)) {
next if is_in (lc $_, $list); msg(1, " $pt already included\n");
push @{$list}, lc $_; next; # Already included, don't worry
if (not add_missing ($list, $packages{lc $_}{"Depends"}, lc $_, $soft_depend, $parents)) { }
msg(1, "couldn't add $_ ...\n"); if (is_in_dep_list(\%t, $list)) {
msg(1, " $pt already in dep list\n");
next;
}
push @{$list}, \%t;
if (not add_missing ($list, $packages{$t{"Package"}}{"Depends"}, \%t, $soft_depend, $parents)) {
my $pkgname = $pkgin{"Package"};
msg(1, "couldn't add $pt ...\n");
if ($soft_depend) { if ($soft_depend) {
msg(1, "soft dep: $pkgin ok, despite missing dep on $_\n"); msg(1, "soft dep: $pkgname ok, despite missing dep on $pt\n");
$ok = 1; $ok = 1;
} else { } else {
msg(1, "$pkgin failed, couldn't satisfy dep on $_\n"); msg(1, "$pkgname failed, couldn't satisfy dep on $pt\n");
pop @{$list}; pop @{$list};
$ok = 0; $ok = 0;
} }
} }
remove_entry(lc $_, $list); remove_entry(\%t, $list);
push @{$list}, lc $_; push @{$list}, \%t;
} }
} }
# If a problem has come up, then restore the original list # If a problem has come up, then restore the original list
if (not $ok) { if (not $ok) {
@{$list} = @backup; @{$list} = @backup;
} }
if (not is_in(lc $pkgin, $list)) { if (not is_in_dep_list(\%pkgin, $list)) {
push @{$list}, lc $pkgin; push @{$list}, \%pkgin;
} }
return $ok; return $ok;
} }
@ -740,30 +985,41 @@ sub is_in {
return 0; return 0;
} }
# Remove an antry from @{$array} # Check if a package dependency is already in a dependency list
sub remove_entry { sub is_in_dep_list {
my $value = shift; my $hash = shift;
my $array = shift; my $array = shift;
my $entries = scalar(@{$array}); my %t = %$hash;
my $i;
for ($i=0; $i < $entries; $i++) { foreach my $key (@{$array}) {
if (@{$array}[$i] eq $value) { my %a = %$key;
splice(@{$array}, $i, 1); if ($a{"Package"} eq $t{"Package"}) {
$i--; my $pn = $a{"Package"};
$entries--; if (check_versions($t{"Version"}, $t{"CmpOp"}, $packages{$pn}{"Version"})) {
} return 1;
} }
}
}
return 0;
} }
# The size of a group of packages # Remove an antry from @{$array}
sub get_size { sub remove_entry {
my $arrayref = shift; my $tmp1 = shift;
my $size = 0; my $array = shift;
foreach (@{$arrayref}) { my $entries = scalar(@{$array});
$size += $packages{$_}{"Size"}; my $i;
my %t1 = %$tmp1;
for ($i=0; $i < $entries; $i++) {
my $tmp2 = @{$array}[$i];
my %t2 = %$tmp2;
if ($t1{"Package"} eq $t2{"Package"}) {
splice(@{$array}, $i, 1);
$i--;
$entries--;
}
} }
return $size;
} }
# Check a list of packages # Check a list of packages
@ -773,31 +1029,34 @@ sub check_list {
my $ok = 1; my $ok = 1;
my @to_remove = (); my @to_remove = ();
my $reasons = ""; my $reasons = "";
foreach (@{$ref}) { foreach my $thispkg (@{$ref}) {
if (not exists $excluded{$_}) { my %t = %$thispkg;
msg(1," $_ has been refused because it doesn't exist ...\n"); my $pkgname = $t{"Package"};
$ok = 0; if (not exists $excluded{$pkgname}) {
push @to_remove, $_; msg(1," $pkgname has been refused because it doesn't exist ...\n");
$reasons = $reasons . " noexist"; $ok = 0;
next; push @to_remove, $thispkg;
$reasons = $reasons . " noexist";
next;
} }
if (not accepted($_)) { if (not accepted($pkgname)) {
msg(1," $_ has been refused because of $excluded{$_} ...\n"); msg(1," $pkgname has been refused because of $excluded{$pkgname} ...\n");
$ok = 0; $ok = 0;
push @to_remove, $_; push @to_remove, $thispkg;
$reasons = $reasons . " " . $excluded{$_}; $reasons = $reasons . " " . $excluded{$pkgname};
next; next;
} }
if ($included{$_}) { if ($included{$pkgname}) {
msg(1, msg(1, " $pkgname has already been included.\n");
" $_ has already been included in CD $included{$_}.\n"); push @to_remove, $thispkg;
push @to_remove, $_; $reasons = $reasons . " alreadyinc";
$reasons = $reasons . " alreadyinc"; next;
next;
} }
} }
foreach my $removed (@to_remove) { foreach my $removed (@to_remove) {
msg(2, " Removing $removed ... ($reasons )\n"); my %t = %$removed;
my $pkgname = $t{"Package"};
msg(2, " Removing $pkgname ... ($reasons )\n");
@{$ref} = grep { $_ ne $removed } @{$ref}; @{$ref} = grep { $_ ne $removed } @{$ref};
} }
return ($fail ? $ok : 1, $reasons); return ($fail ? $ok : 1, $reasons);
@ -805,20 +1064,15 @@ sub check_list {
# Add packages to the output list # Add packages to the output list
sub add_to_output { sub add_to_output {
my $size = shift; my $pkgname = shift;
my $ref = shift; my $size = $packages{$pkgname}{"Size"};
msg(2, " \$output_size = $output_size, \$size = $size\n");
$output_size += $size; $output_size += $size;
$included{$pkgname} = 1;
foreach my $pkg (@{$ref}) { push(@output, $pkgname);
$included{$pkg} = 1;
}
push(@output, @{$ref});
} }
sub yesno { sub yesno {
my $in = shift; my $in = shift;
return $in ? "yes" : "no"; return $in ? "yes" : "no";
} }