#!/usr/bin/perl # $FreeBSD$ use File::Basename; use File::Find; use File::Path; my $debug = 1; my $fake = 0; 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.tgz"); mkpath("$disc/packages/All"); if ($fake) { system("touch $disc/packages/All/$name.tgz"); } else { system("cp -f $pkgDir/All/$name.tgz $disc/packages/All"); } # Create symlinks in each category. foreach $cat (@{$pkg->{cats}}) { debugPrint("creating $disc/packages/$cat/$name.tgz"); mkpath("$disc/packages/$cat"); symlink("../All/$name.tgz", "$disc/packages/$cat/$name.tgz"); } # If required created the Latest symlink. mkpath("$disc/packages/Latest"); if ($pkg->{latest}) { symlink("../All/$name.tgz", "$disc/packages/Latest/$base.tgz"); } # 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.tgz"; my $pkg = "$pkgDir/All/$name.tgz"; 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; $_ = ; chomp; if (/^disc (\w+)/) { $disc = $1; } else { die "invalid first line in $neededPkgs: $_"; } while () { 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 () { 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 () { 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.tgz"))[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 "; } $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}); } }