#!/usr/bin/perl -w
#
# $Id:$

=head1 AUTHOR

Thomas Lundquist <thomasez@zelow.no>

=head1 NAME

modpick.pl

=head1 SYNOPSIS

modpick.pl [options] -m <Module(s)>

=head1 DESCRIPTION

Gives the right option it will return a list with the required modules.

And no, this script ain't made for efficiency and I've used a script 
I made a few years ago as the base, it may not be perfect..

=head1 OPTIONS

=over

=item -m, --module <STRING> REQUIRED

A module name or list of modules.

with options in () after the module.

=item -k, --kernelversion <STRING>

The kernel version.

(This can also be set in modpick.conf)

=item -r, --moduleroot <STRING>

The root of the module tree.

(This can also be set in modpick.conf)

=item -c, --copyto <STRING>

The base directory for copying the modules to.

(This can also be set in modpick.conf)

=item -d --deplist

Prints a list of modules, with path relative to the moduleroot, needed
for the specified module.

=item -h --help

Prints short help message about usage.

=back

=cut


use strict;
use Getopt::Long qw(:config gnu_getopt); #);
use Pod::Usage;
use Data::Dumper;
use File::Basename;
use Text::ParseWords;


use vars qw($help $moduleroot $kernelversion $modules $copyto $deplist $help);

if ( -f "./modpick.conf" ) { require ("./modpick.conf"); }

my %opts = ("help|h"		=> \$help,
            "kernelversion|k=s"	=> \$kernelversion,
            "moduleroot|r=s"	=> \$moduleroot,
            "module|m=s"	=> \$modules,
            "copyto|c=s"	=> \$copyto,
            "deplist|d"		=> \$deplist,
            );

GetOptions(%opts);

if ($help) {
    pod2usage(1);
    exit(0);
}

unless ($kernelversion && $moduleroot && $modules) {
    pod2usage(1);
    exit(1);
}

my ($allmodules, $p) = &readModulesDep();

# print STDERR Dumper($allmodules);

my (@deplist);
my (%optlist);
my ($last_module);

foreach my $module ( quotewords('\s+', 0, $modules) ) {

# print STDERR "this: ($module)\n";

	# Ok, first we have to check for options.
	# If there are only one option inside we'll both start and end
	# here.
	if (  $module =~ /(.*)\)/ &&  $module !~ /\(/ ) {

		$optlist{$last_module} .= ($1 . " ");
		# So, get rid of the (first) eventual (
		$optlist{$last_module} =~ s/\(//;

		$last_module = undef;
		next;
		
	}

	if ($last_module && exists($optlist{$last_module})) {
		$optlist{$last_module} .= ($module . " ");
		next;
	}
	
	if ($module =~ /(.*)\((.*)/) {

		$module = $last_module = ($1 || $last_module);
		# Too much of .o and not .o for my liking.
		$last_module =~ s/\.o$//;
		$optlist{$last_module} .= ($2 . " ");

		# $last_module = undef if ($optlist{$last_module} =~ s/\)//);
		if ($optlist{$last_module} =~ /\)/) {
			$optlist{$last_module} =~ s/\)//;
			$last_module = undef;
		}

	} else {
		$last_module = $module;
	}
		

	next unless ($module);

	$module .= ".o" unless ($module =~ /\.o$/);

	unless (defined($allmodules->{$module})) { 
		die "Module $module not found.\n";
	}

# print STDERR "getDependFiles($module)\n";

	push @deplist,  getDependFiles($module);

}

if ($copyto) {
	die "No directory" unless ( -d $copyto );


	foreach my $module (@deplist) {
# print STDERR "copyto($module)\n";
		# Quick and dirty:
		my ($dn) = dirname($module);
		my ($bn) = basename($module);
		my ($nd) = "$copyto/lib/modules/$kernelversion/kernel/$dn";

# print STDERR "$nd\n";

		system('mkdir', '-p', $nd);
		system('cp', "$moduleroot/lib/modules/$kernelversion/kernel/$module", $nd . "/.");

	}

}

# This is not really the deplist but the list you can use
# for modules.lst
if ($deplist) {

	map { s/.*\/// } @deplist;
	map { s/\.o// } @deplist;

	# I shall say this only once.
	# And never read it again, thanks Peder.
	# printf "%s\n", join "\n", do { my %f; grep { ! $f{$_}++ } @deplist };
	# But, this oneliner was neat altho I need to add options.
	my %f;
	foreach my $d (@deplist) {
		next if ($f{$d});
		$f{$d}++;
		print $d;
		if (exists($optlist{$d})) { print " " . $optlist{$d}; };
		print "\n";
	}	

} else {
	# Not sure I need this.
	print join(" ", @deplist) . "\n";

}

# print STDERR "PATHS:\n\n";
# &printPaths($m, $p);

sub getDependFiles {
	my ($mod) = @_;
	my (@retarr);

# print STDERR "Testing $mod\n";

	# First, check if there are (more) dependencies:
	# If so, recurseively, ask for more files:
	if (exists($allmodules->{$mod}->{depends})) {
		foreach my $mo (@{$allmodules->{$mod}->{depends}}) {
# print STDERR "Checking $mo\n";
			push @retarr, getDependFiles($mo);
		}
	}

	push @retarr, $allmodules->{$mod}->{file};

	return @retarr;


}

sub readModulesDep {

	my ($modules, $paths);
	my ($depfile) = $moduleroot . "/lib/modules/" . $kernelversion . "/modules.dep";
	open (DEP, "$depfile" )
		 or die "No modules.dep.\n";

	my ($last_module);
	while (<DEP>) {

		chomp;
		next unless (/kernel/);

		my ($line) = /\w+\/kernel\/(.*)/;

# print STDERR "\n\n" . $line . "\n";

		if ($line =~ /\:/) {
			$last_module = undef;

			# To fix busybox depmod.pl:
			$line =~ s/\s+$//;

			my ($modline, $dep) = split (/\:/, $line);
			my (@path) = split (/\//, $modline);

			my ($module, $lastp, $lastp1, $lastp2, $lastp3);

			foreach my $p (@path) {
				#
				# We have a module;
				#
				($module) = $1 if ( $p =~ /(.*\.o)/ );

				if ($module) {
					# Gawd this is ugly.

					if ($lastp1) { push @{$paths->{$lastp}->{'modules'}}, $module; }

					if ($lastp2) { push @{$paths->{$lastp}->{$lastp1}->{'modules'}}, $module; }

					if ($lastp3) { 
						push @{$paths->{$lastp}->{$lastp1}->{$lastp2}->{'modules'}}, $module;
						push @{$paths->{$lastp}->{$lastp1}->{$lastp2}->{$lastp3}->{'modules'}}, $module;
					}


					$modules->{$module}->{'file'} = $modline;

					next;
				}


				# Gawd this is ugly. Part II.
				$lastp3 = $p if ($lastp && $lastp1 && $lastp2 && !$lastp3);
				$lastp2 = $p if ($lastp && $lastp1 && !$lastp2);
				$lastp1 = $p if ($lastp && !$lastp1);
				$lastp = $p if (!$lastp);


			}
# print STDERR $module . ";" . $lastp . ";" . $lastp1 . ";" . $lastp2 . ";" . "$lastp3;\n";

			if ($dep) {
# print STDERR "DEP: $dep\n";
				foreach my $single (split(/\s+/, $dep)) {
					my ($dmodule) = $1 if ($single =~ /\/(\w+-?\w+\.o)/);
					next unless $dmodule;
# print STDERR "DEPM: $module-$dmodule-$single\n";
					push @{$modules->{$module}->{'depends'}}, $dmodule;
					$last_module = $module;
				}

			}



		}

		if ($last_module && $line =~ /^\t/) {
			my ($dmodule) = $1 if ( $_ =~ /(.*\.o)/ );
# print STDERR "DEPM2: $dmodule\n";

			push @{$modules->{$last_module}->{'depends'}}, $dmodule;
		}
		

	}
	
	close (DEP);
	return ($modules, $paths);

}

sub printPaths {
	my ($modules, $path, $level) = @_;

	$level++;

	foreach my $pat (sort(keys (%$path))) {
		print "Path:$pat\n" if ($pat && $pat ne "modules");
		if ($pat eq "modules") {
			foreach my $mod (@{$path->{'modules'}}) {
				print "\t$mod - ";
				print join (";", @{$modules->{$mod}->{'depends'}}) if (exists($modules->{$mod}->{'depends'}));
				print "\n";


			}
			next;
		}
		&printPaths($modules, $path->{$pat}, $level) if (ref($path->{$pat}) eq "HASH");
	}

}