path: root/Tools/scripts/release/oneshot.pl

#!/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});
    }
}