mirror of
https://git.FreeBSD.org/ports.git
synced 2024-12-11 02:50:24 +00:00
426 lines
9.8 KiB
Perl
Executable File
426 lines
9.8 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
# $FreeBSD$
|
|
|
|
use File::Basename;
|
|
use File::Find;
|
|
use File::Path;
|
|
|
|
my $debug = 1;
|
|
my $fake = 0;
|
|
my $pkg_ext = "tbz";
|
|
|
|
my %discs;
|
|
my %distfiles;
|
|
my %index;
|
|
my %unplaced;
|
|
|
|
sub copyDist($$) {
|
|
my $disc = shift;
|
|
my $name = shift;
|
|
|
|
my $distfile = "$disc/distfiles/$name";
|
|
my $dir = dirname($distfile);
|
|
mkpath($dir);
|
|
|
|
debugPrint("copying $distfile");
|
|
if ($fake) {
|
|
system("touch $distfile");
|
|
} else {
|
|
system("cp $distDir/$name $distfile");
|
|
}
|
|
}
|
|
|
|
sub copyPkg($$) {
|
|
my $disc = shift;
|
|
my $name = shift;
|
|
my $pkg = $index{$name};
|
|
my $base = $pkg->{base};
|
|
my $text = $pkg->{INDEX};
|
|
|
|
# Copy over the package.
|
|
debugPrint("copying $disc/packages/All/$name.$pkg_ext");
|
|
mkpath("$disc/packages/All");
|
|
if ($fake) {
|
|
system("touch $disc/packages/All/$name.$pkg_ext");
|
|
} else {
|
|
system("cp -f $pkgDir/All/$name.$pkg_ext $disc/packages/All");
|
|
}
|
|
|
|
# Create symlinks in each category.
|
|
foreach $cat (@{$pkg->{cats}}) {
|
|
debugPrint("creating $disc/packages/$cat/$name.$pkg_ext");
|
|
mkpath("$disc/packages/$cat");
|
|
symlink("../All/$name.$pkg_ext", "$disc/packages/$cat/$name.$pkg_ext");
|
|
}
|
|
|
|
# If required created the Latest symlink.
|
|
mkpath("$disc/packages/Latest");
|
|
if ($pkg->{latest}) {
|
|
symlink("../All/$name.$pkg_ext", "$disc/packages/Latest/$base.$pkg_ext");
|
|
}
|
|
|
|
# Add the package to INDEX.
|
|
open(BAR, ">>$disc/packages/INDEX");
|
|
print(BAR "$text\n");
|
|
close(BAR);
|
|
}
|
|
|
|
sub debugPrint($) {
|
|
my $line = shift;
|
|
print STDERR $line . "\n" if $debug;
|
|
}
|
|
|
|
sub addDistfile() {
|
|
return if -d;
|
|
|
|
my $name = $File::Find::name;
|
|
my $size = (stat($name))[7];
|
|
|
|
# Don't record distfiles that are of zero length.
|
|
if ($size == 0) {
|
|
debugPrint("zero length distfile: $name");
|
|
return;
|
|
}
|
|
|
|
$name =~ s!$distDir/!!;
|
|
$distfiles{$name} = $size;
|
|
}
|
|
|
|
sub doDistfiles() {
|
|
my %clumps;
|
|
|
|
# Get a list of all the disfiles and their sizes.
|
|
find(\&addDistfile, $distDir);
|
|
|
|
# xxx Need to clump distfiles so that all the ones for a port end up
|
|
# xxx on the same disc. For now each distfile is it's own clump. :(
|
|
foreach $distfile (sort keys %distfiles) {
|
|
my @a = ($distfile);
|
|
$clumps{$distfiles{$distfile}} = \@a;
|
|
}
|
|
|
|
# Place as many clumps as we can fit on each disc.
|
|
foreach $disc (sort keys %discs) {
|
|
next if ! $discs{$disc}->{distFlag};
|
|
|
|
my $d = $discs{$disc};
|
|
my @keys = sort { $a <=> $b } (keys %clumps);
|
|
|
|
debugPrint("placing distfiles on $disc ...");
|
|
|
|
while ($d->{avail} > 0) {
|
|
my $workDone = 0;
|
|
|
|
foreach $size (@keys) {
|
|
last if ($size > $d->{avail});
|
|
placeDist($disc, $size, @{$clumps{$size}});
|
|
delete $clumps{$size};
|
|
$workDone++;
|
|
}
|
|
|
|
debugPrint("workDone = $workDone");
|
|
last if (!$workDone);
|
|
}
|
|
}
|
|
|
|
# Put the remaining clumps on the scratch disc.
|
|
foreach $size (keys %clumps) {
|
|
placeDist('scratch', $size, @{$clumps{$size}});
|
|
}
|
|
}
|
|
|
|
sub doPackages() {
|
|
# Place as many packages as we can fit on each disc.
|
|
foreach $disc (sort keys %discs) {
|
|
next if ! $discs{$disc}->{pkgFlag};
|
|
|
|
my $d = $discs{$disc};
|
|
|
|
debugPrint("placing packages on $disc ...");
|
|
my $d = $discs{$disc};
|
|
|
|
while ($d->{avail} > 0) {
|
|
redoImpact($disc);
|
|
|
|
my $workDone = 0;
|
|
my @keys = sort { $impact{$a} <=> $impact{$b} } (keys %unplaced);
|
|
|
|
foreach $name (@keys) {
|
|
if ($impact{$name} <= $d->{avail}) {
|
|
placePkg($disc, $name, 0);
|
|
$workDone = 1;
|
|
last;
|
|
}
|
|
}
|
|
|
|
last if (!$workDone);
|
|
}
|
|
}
|
|
|
|
# Put all the unplaced packages on the scratch disc.
|
|
redoImpact('scratch');
|
|
foreach $name (keys %unplaced) {
|
|
debugPrint("uplaced package: $name");
|
|
placePkg('scratch', $name, 0);
|
|
}
|
|
}
|
|
|
|
sub isLatest($$) {
|
|
my ($name, $base) = @_;
|
|
my $link = "$pkgDir/Latest/$base.$pkg_ext";
|
|
my $pkg = "$pkgDir/All/$name.$pkg_ext";
|
|
|
|
return 0 if ! -l $link;
|
|
|
|
my ($dev1, $ino1) = stat($pkg);
|
|
my ($dev2, $ino2) = stat($pkg);
|
|
|
|
return $dev1 == $dev2 && $ino1 == $ino2;
|
|
}
|
|
|
|
sub placeDist($$@) {
|
|
my $disc = shift;
|
|
my $size = shift;
|
|
my @distfiles = @_;
|
|
my $d = $discs{$disc};
|
|
|
|
# Adjust sizes of disc based on the impact of this package.
|
|
$d->{used} += $size;
|
|
$d->{avail} -= $size;
|
|
|
|
# Add each of the distfiles to this disc.
|
|
foreach $name (@distfiles) {
|
|
debugPrint("placing $name on $disc");
|
|
$d->{distfiles}->{$name}++;
|
|
}
|
|
}
|
|
|
|
sub placeNeeded() {
|
|
local *NEEDED;
|
|
|
|
debugPrint("reading $neededPkgs and placing packages ...");
|
|
open(NEEDED, $neededPkgs)
|
|
or die "unable to read $neededPkgs: $!\n";
|
|
|
|
my $disc;
|
|
|
|
$_ = <NEEDED>;
|
|
chomp;
|
|
|
|
if (/^disc (\w+)/) {
|
|
$disc = $1;
|
|
} else {
|
|
die "invalid first line in $neededPkgs: $_";
|
|
}
|
|
|
|
while (<NEEDED>) {
|
|
chomp;
|
|
|
|
if (/^disc (\w+)/) {
|
|
$disc = $1;
|
|
next;
|
|
}
|
|
|
|
if (defined($index{$_})) {
|
|
placePkg($disc, $_, 1);
|
|
} else {
|
|
# die "missing needed package: $_";
|
|
}
|
|
}
|
|
|
|
close(NEEDED);
|
|
}
|
|
|
|
sub placePkg($$$) {
|
|
my $disc = shift;
|
|
my $name = shift;
|
|
my $nodeps = shift;
|
|
|
|
debugPrint(" placing $name on $disc");
|
|
|
|
my $size;
|
|
|
|
if ($nodeps) {
|
|
$size = $index{$name}->{size};
|
|
} else {
|
|
$size = $impact{$name};
|
|
}
|
|
|
|
# Adjust sizes of disc based on the impact of this package.
|
|
my $d = $discs{$disc};
|
|
|
|
$d->{used} += $size;
|
|
$d->{avail} -= $size;
|
|
|
|
# Remove this package from unplaced and place it on this disc.
|
|
delete $unplaced{$name};
|
|
$d->{pkgs}->{$name}++;
|
|
|
|
# Now do the same thing for the dependencies.
|
|
return if $nodeps;
|
|
|
|
foreach (@{$index{$name}->{rdeps}}) {
|
|
delete $unplaced{$_};
|
|
$d->{pkgs}->{$_}++;
|
|
}
|
|
}
|
|
|
|
sub readDiscInfo() {
|
|
local *INFO;
|
|
|
|
# Make sure we have at least disc that will be the place overflow will go.
|
|
my $disc = {
|
|
'avail' => 0,
|
|
'distFlag' => 0,
|
|
'distfiles' => {},
|
|
'name' => 'scratch',
|
|
'pkgFlag' => 0,
|
|
'pkgs' => {},
|
|
'size' => 0,
|
|
'used' => 0
|
|
};
|
|
$discs{'scratch'} = $disc;
|
|
|
|
debugPrint("reading $discInfo ...");
|
|
open(INFO, $discInfo)
|
|
or die "unable to read $discInfo: $!";
|
|
|
|
while (<INFO>) {
|
|
chomp;
|
|
next if (/^#/);
|
|
|
|
my @f = split(/\s+/);
|
|
next if (@f != 4);
|
|
|
|
my $disc = {
|
|
'avail' => $f[3],
|
|
'distFlag' => $f[2],
|
|
'distfiles' => {},
|
|
'name' => $f[0],
|
|
'pkgFlag' => $f[1],
|
|
'pkgs' => {},
|
|
'size' => $f[3],
|
|
'used' => 0
|
|
};
|
|
|
|
$discs{$f[0]} = $disc;
|
|
}
|
|
|
|
close(INFO);
|
|
}
|
|
|
|
sub readIndex() {
|
|
local *INDEX;
|
|
|
|
debugPrint("reading $indexFilename ...");
|
|
open(INDEX, $indexFilename)
|
|
or die "unable to read $indexFilename: $!";
|
|
|
|
while (<INDEX>) {
|
|
chomp;
|
|
|
|
my @f = split(/\|/);
|
|
my $name = $f[0];
|
|
my $base = $name;
|
|
|
|
$base =~ s/-[^-]*$//;
|
|
|
|
my $pkg = {
|
|
'INDEX' => $_,
|
|
'base' => $base,
|
|
'cats' => [split(/\s+/, $f[6])],
|
|
'distfiles' => {},
|
|
'latest' => isLatest($name, $base),
|
|
'name' => $name,
|
|
'rdeps' => [split(/\s+/, $f[8])],
|
|
'size' => (stat("$pkgDir/All/$name.$pkg_ext"))[7],
|
|
};
|
|
|
|
# debugPrint("adding " . $pkg->{name});
|
|
# die "duplicate package: $name" if ($debug && defined($index{$name}));
|
|
$index{$name} = $pkg;
|
|
$unplaced{$name} = 1;
|
|
}
|
|
|
|
close(INDEX);
|
|
}
|
|
|
|
sub _impact($$) {
|
|
my $disc = shift;
|
|
my $name = shift;
|
|
|
|
# Return previously calculated value if we have it.
|
|
return $impact{$name} if defined($impact{$name});
|
|
|
|
my $pkg = $index{$name};
|
|
my @rdeps = @{$pkg->{rdeps}};
|
|
my $size = $pkg->{size};
|
|
|
|
# If no dependencies then the impact is the size of this package.
|
|
return $impact{$name} = $size if (!@rdeps);
|
|
|
|
# Otherwise the impact is this package's size plus any dependencies
|
|
# that are not already on this disc.
|
|
foreach (@rdeps) {
|
|
$size += $index{$_}->{size} if !defined($discs{$disc}->{pkgs}->{$_});
|
|
}
|
|
|
|
return $impact{$name} = $size;
|
|
}
|
|
|
|
sub redoImpact($) {
|
|
my $disc = shift;
|
|
|
|
# Reset the impact hashtable.
|
|
%impact = undef;
|
|
|
|
# Calculate the impact for each unplaced package.
|
|
foreach $pkg (keys %unplaced) {
|
|
$impact{$pkg} = _impact($disc, $pkg);
|
|
}
|
|
}
|
|
|
|
MAIN: {
|
|
if ($#ARGV != 5) {
|
|
die "$0 <disc_info> <needed_pkgs> <INDEX> <ports_dir> <pkg_dir> <dist_dir>";
|
|
}
|
|
|
|
$discInfo = shift(@ARGV);
|
|
$neededPkgs = shift(@ARGV);
|
|
$indexFilename = shift(@ARGV);
|
|
$portsDir = shift(@ARGV);
|
|
$pkgDir = shift(@ARGV);
|
|
$distDir = shift(@ARGV);
|
|
|
|
readDiscInfo();
|
|
readIndex();
|
|
placeNeeded();
|
|
|
|
# bail if any of the discs have overflowed.
|
|
foreach (keys %discs) {
|
|
my $avail = $discs{$_}->{avail};
|
|
die "disc $_ has overflowed: avail = $avail\n" if ($avail < 0);
|
|
print "avail for disc $_ = $avail\n" if ($debug);
|
|
}
|
|
|
|
doPackages();
|
|
doDistfiles();
|
|
|
|
# Now that we know where everything should go. Make it so.
|
|
foreach $disc (sort keys %discs) {
|
|
debugPrint("copying packages to $disc ...");
|
|
foreach $name (keys %{$discs{$disc}->{pkgs}}) {
|
|
copyPkg($disc, $name);
|
|
}
|
|
|
|
debugPrint("copying distfiles to $disc ...");
|
|
foreach $name (keys %{$discs{$disc}->{distfiles}}) {
|
|
copyDist($disc, $name);
|
|
}
|
|
}
|
|
|
|
foreach $disc (sort keys %discs) {
|
|
debugPrint("$disc: avail = " . $discs{$disc}->{avail});
|
|
}
|
|
}
|