Subject: Possible speed improvement to mk/bulk/tflat
To: None <tech-pkg@netbsd.org>
From: Todd Vierling <tv@duh.org>
List: tech-pkg
Date: 10/10/2005 14:40:33
It's somewhat convenient that a bulk build requires lang/perl5.  I would
like to replace the tflat awk script, which does its work by forking off
hordes of "sort" subprocesses -- slow as ants on Interix, for one.

I cobbled together the following perl script that is *much* faster (more
than 95% in my empirical tests on Interix, and at least twice as fast on
NetBSD).  The usage is slightly different; it's faster to output both
dependency files at once, so this script should be run as:

perl tflat.pl .supports .depends <.dependstree

One note is that this script does not print out no-dependency packages at
all.  I don't think the bulk build system cares if the line is omitted
entirely, but I don't yet know if that is true, as this hasn't been tried in
a bulk build yet.

I'd like comments on whether this approach would be acceptable once this is
tested to be working in a bulk build.  I know other perl code is in the bulk
build scheme, but I don't want to tread in "the wrong place" with yet
another perl script.

=====
# $NetBSD$
#
# Copyright (c) 2005 The NetBSD Foundation, Inc.
# All rights reserved.
#
# This code is derived from software contributed to The NetBSD Foundation
# by Todd Vierling.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#        This product includes software developed by the NetBSD
#        Foundation, Inc. and its contributors.
# 4. Neither the name of The NetBSD Foundation nor the names of its
#    contributors may be used to endorse or promote products derived
#    from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
# ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#

use strict;

sub usage () {
	print STDERR "usage: $0 upfile downfile\n";
	exit 1;
}

my $upfile = shift(@ARGV) || usage();
my $downfile = shift(@ARGV) || usage();
scalar(@ARGV) && usage();

open(UPF, ">$upfile") || die $!;
open(DOWNF, ">$downfile") || die $!;

# read in dependstree file

my %depended;
my %depends;
while (<>) {
	chomp;
	my ($dep, $pkg) = split;

	push(@{$depended{$dep}}, $pkg);
	push(@{$depends{$pkg}}, $dep);
}

# print out upfile and downfile

sub getdeps ($$$@) {
	my $curhash = shift;
	my $alldeps = shift;
	my $what = shift;

	foreach my $dep (@{$curhash->{$what}}) {
		if ($what eq $dep) {
			next;
		} elsif (grep { $_ eq $dep } @_) {
			print STDERR "circular dependency in $dep\n";
		} elsif (!grep { $_ eq $dep } @$alldeps) {
			push(@$alldeps, $dep);
			getdeps($curhash, $alldeps, $dep, $what, @_);
		}
	}
}

foreach my $pkg (sort(keys(%depended))) {
	my @alldeps;
	getdeps(\%depended, \@alldeps, $pkg);
	print UPF "$pkg is depended on by:  ".join(' ', @alldeps)."\n";
}

foreach my $pkg (sort(keys(%depends))) {
	my @alldeps;
	getdeps(\%depends, \@alldeps, $pkg);
	print DOWNF "$pkg depends on:  ".join(' ', @alldeps)."\n";
}

close(UPF);
close(DOWNF);
__END__

-- 
-- Todd Vierling <tv@duh.org> <tv@pobox.com> <todd@vierling.name>