Blame group-source-files.pl

Bernhard M. Wiedemann 6ebc4a
#!/usr/bin/perl
Bernhard M. Wiedemann 6ebc4a
2b6f75
use File::Spec;
Bernhard M. Wiedemann 6ebc4a
use Getopt::Long;
Bernhard M. Wiedemann 6ebc4a
use strict;
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
&main();
Bernhard M. Wiedemann 6ebc4a
sub main
Bernhard M. Wiedemann 6ebc4a
{
Bernhard M. Wiedemann 6ebc4a
	my($dev_output, $ndev_output, $loc) = ("-", "-", ".");
Bernhard M. Wiedemann 6ebc4a
	&Getopt::Long::Configure(qw(bundling));
Bernhard M. Wiedemann 6ebc4a
	&GetOptions(
Bernhard M. Wiedemann 6ebc4a
		"D=s" => \$dev_output,
Bernhard M. Wiedemann 6ebc4a
		"N=s" => \$ndev_output,
Bernhard M. Wiedemann 6ebc4a
		"L=s" => \$loc,
Bernhard M. Wiedemann 6ebc4a
	);
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
	my($dev, $ndev) = &scan($loc);
Bernhard M. Wiedemann 6ebc4a
	&output($dev, $ndev, $dev_output, $ndev_output);
Bernhard M. Wiedemann 6ebc4a
}
Bernhard M. Wiedemann 6ebc4a
7a1991
sub rpm_quote_filename
7a1991
{
7a1991
	# technically should also quote  % -> %%  " -> \"  \ -> \\
7a1991
	return map { "\"$_\"" } @_;
7a1991
}
7a1991
Bernhard M. Wiedemann 6ebc4a
sub scan
Bernhard M. Wiedemann 6ebc4a
{
2b6f75
	# Normalize file path, mainly to strip away the ending forward slash,
2b6f75
	# or any double forward slashes.
2b6f75
	my $loc = File::Spec->canonpath(shift @_);
2b6f75
	# We cannot use an absolute path (e.g. /usr/src/linux-5.14.21-150500.41)
2b6f75
	# during find because it's under build root, but rpm wants one later.
2b6f75
	my $abs_loc = rpm_path($loc);
Bernhard M. Wiedemann 6ebc4a
	my(@dev, @ndev);
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
	foreach $_ (`find "$loc"`)
Bernhard M. Wiedemann 6ebc4a
	{
Bernhard M. Wiedemann 6ebc4a
		chomp $_;
Bernhard M. Wiedemann 6ebc4a
		if (-d $_ && !-l $_) {
Bernhard M. Wiedemann 6ebc4a
			# Generate directory list later.
Bernhard M. Wiedemann 6ebc4a
			next;
Bernhard M. Wiedemann 6ebc4a
		}
Bernhard M. Wiedemann 6ebc4a
		my $is_devel =
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E.*/Kconfig} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E.*/Kbuild} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E.*/Makefile} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/[^/]+/boot/dts/include/dt-bindings\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/[^/]+/include\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/.*/module\.lds\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/arm/[^/]+/include/mach\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/arm/[^/]+/include/plat\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/[^/]+/scripts\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/arch/[^/]+/tools\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/include/[^/]+\b} ||
Bernhard M. Wiedemann 6ebc4a
			m{^\Q$loc\E/scripts\b};
2b6f75
		my $abs_path = rpm_path($_);
2b6f75
		$is_devel ? push(@dev, $abs_path) : push(@ndev, $abs_path);
Bernhard M. Wiedemann 6ebc4a
	}
Bernhard M. Wiedemann 6ebc4a
7a1991
	my @dev_dirs = calc_dirs($abs_loc, \@dev);
7a1991
	my @ndev_dirs = calc_dirs($abs_loc, \@ndev);
7a1991
	@dev = rpm_quote_filename(@dev);
7a1991
	@ndev = rpm_quote_filename(@ndev);
7a1991
	@dev_dirs = map { "\%dir $_" } rpm_quote_filename(@dev_dirs);
7a1991
	@ndev_dirs = map { "\%dir $_" } rpm_quote_filename(@ndev_dirs);
7a1991
	push(@dev, @dev_dirs);
7a1991
	push(@ndev, @ndev_dirs);
Bernhard M. Wiedemann 6ebc4a
	return (\@dev, \@ndev);
Bernhard M. Wiedemann 6ebc4a
}
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
sub calc_dirs
Bernhard M. Wiedemann 6ebc4a
{
Bernhard M. Wiedemann 6ebc4a
	my($base, $files) = @_;
Bernhard M. Wiedemann 6ebc4a
	my %dirs;
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
	foreach my $file (@$files) {
2b6f75
		my ($volume,$path,$basename) = File::Spec->splitpath($file);
2b6f75
		my @dirs = File::Spec->splitdir($path);
Bernhard M. Wiedemann 6ebc4a
		do {
2b6f75
			# Always create $path from catdir() to avoid ending forward slash
2b6f75
			$path = File::Spec->catdir(@dirs);
Bernhard M. Wiedemann 6ebc4a
			$dirs{$path} = 1;
2b6f75
			pop @dirs;
2b6f75
		} while ($path ne $base);
Bernhard M. Wiedemann 6ebc4a
		# This loop also makes sure that $base itself is included.
Bernhard M. Wiedemann 6ebc4a
	}
Bernhard M. Wiedemann 6ebc4a
7a1991
	return keys %dirs;
Bernhard M. Wiedemann 6ebc4a
}
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
sub output
Bernhard M. Wiedemann 6ebc4a
{
Bernhard M. Wiedemann 6ebc4a
	my($dev, $ndev, $dev_out, $ndev_out) = @_;
Bernhard M. Wiedemann 6ebc4a
	local *FH;
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
	open(FH, "> $dev_out") || warn "Error writing to $dev_out: $!";
Bernhard M. Wiedemann 6ebc4a
	print FH join("\n", @$dev), "\n";
Bernhard M. Wiedemann 6ebc4a
	close FH;
Bernhard M. Wiedemann 6ebc4a
Bernhard M. Wiedemann 6ebc4a
	open(FH, "> $ndev_out") || warn "Error writing to $ndev_out: $!";
Bernhard M. Wiedemann 6ebc4a
	print FH join("\n", @$ndev), "\n";
Bernhard M. Wiedemann 6ebc4a
	close FH;
Bernhard M. Wiedemann 6ebc4a
}
2b6f75
2b6f75
sub rpm_path
2b6f75
{
2b6f75
	my $path = shift @_;
2b6f75
	# Always prepend forward slash and let canonpath take care of
2b6f75
	# duplicate forward slashes.
2b6f75
	return File::Spec->canonpath("/$path");
2b6f75
}