1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
package Modules::Deps;
# $Id: Deps.pm,v 1.4 2003/06/27 15:17:15 sdague Exp $
# Copyright (c) 2001-2002 International Business Machines
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# Sean Dague <sean@dague.net>
use strict;
use Carp;
use Util::Log qw(:all);
use base qw(Exporter);
use vars qw($VERSION @EXPORT);
@EXPORT = qw(get_deps uniq);
$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
sub get_deps {
my ($version, $module) = @_;
verbose("Getting kernel dependancies for kernel $version");
my $file = "/lib/modules/$version/modules.dep";
my @deps = lookup_deps($file,$module);
my @left = @deps;
while(my $mod = shift(@left)) {
my @tmp = lookup_deps($file,$mod);
unshift @deps, @tmp;
push @left, @tmp;
}
return uniq(@deps);
}
sub lookup_deps {
my ($file, $module) = @_;
my @deps = ();
open(IN,"<$file") or (carp "Couldn't open $file for modules.dep analysis", return ());
my $line = "";
while(<IN>) {
if(/$module.o(.gz)?:\s+(.+)/) {
verbose("Found line for $module");
# I don't think $1 gets set if .gz is missing, hence the following
my $line = ($2) ? $2 : $1;
my $last = $line;
$line =~ s/\\*\s*$//;
while($last =~ /\\\s*$/) {
my $more = <IN>;
$last = $more;
$more =~ s/\\*\s*$//;
$line .= $more;
}
push @deps, parse_deps($line);
}
}
close(IN);
return @deps;
}
sub parse_deps {
my $line = shift;
my @modules = ();
my @lines = split(/\s+/,$line);
foreach my $l (@lines) {
if($l =~ /([^\/]+).o(.gz)?$/) {
push @modules, $1;
}
}
return @modules;
}
sub uniq {
my @list = @_;
my @newlist = ();
my %hash = ();
for (@list) {
next if $hash{$_};
push @newlist, $_;
$hash{$_}++;
}
return @newlist;
}
1;
|
