root/floppyfw-3.0/perl/modpick.pl

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

}