summaryrefslogtreecommitdiffstats
path: root/perl-install/modalias.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/modalias.pm')
-rw-r--r--perl-install/modalias.pm84
1 files changed, 84 insertions, 0 deletions
diff --git a/perl-install/modalias.pm b/perl-install/modalias.pm
new file mode 100644
index 000000000..3ff863e30
--- /dev/null
+++ b/perl-install/modalias.pm
@@ -0,0 +1,84 @@
+package modalias;
+
+# TODO:
+# - be faster (Elapsed time: lspcidrake.pl ~ 0.28s instead of 0.12s for old lspcidrake
+
+use strict;
+use MDK::Common;
+use c;
+
+my @config_groups = (
+ [
+ "/lib/module-init-tools/modprobe.default",
+ "/etc/modprobe.conf",
+ "/etc/modprobe.d",
+ ],
+ [
+ "/lib/modules/" . c::kernel_version() . "/modules.alias",
+ ],
+);
+my @classes = qw(ide ieee1394 input pci pcmcia pnp serio usb);
+my @alias_groups;
+
+sub alias_to_ids {
+ my ($alias) = @_;
+ my ($vendor, $device);
+ # returns (vendor, device)
+ if (($vendor, $device) = $alias =~ /:v([0-9A-F]{4})[dp]([0-9A-F]{4})/) {
+ return ($vendor, $device);
+ } elsif (($vendor, $device) = $alias =~ /:v0{4}([0-9A-F]{4})[dp]0{4}([0-9A-F]{4})/) {
+ return ($vendor, $device);
+ }
+}
+
+sub parse_path {
+ my ($group, $path) = @_;
+ if (-d $path) {
+ parse_path($group, "$path/$_") foreach all($path);
+ } elsif (-f $path) {
+ foreach (cat_($path)) {
+ if (my ($alias, $class, $module) = /^\s*alias\s+(([^:]+):\S+)\s+(\S+)$/) {
+ my ($vendor, $device) = alias_to_ids($alias);
+ if (member($class, @classes)) {
+ if ($vendor) {
+ $group->{$class} ||= {};
+ $group->{$class}{$vendor} ||= {};
+ $group->{$class}{$vendor}{$device} ||= [];
+ push @{$group->{$class}{$vendor}{$device}}, $alias, $module;
+ } else {
+ push @{$group->{$class}{other}}, $alias, $module;
+ }
+ }
+ }
+ }
+ }
+}
+
+sub get_alias_groups() {
+ @alias_groups = map {
+ my $group = {};
+ parse_path($group, $_) foreach @$_;
+ $group;
+ } @config_groups unless @alias_groups;
+ @alias_groups;
+}
+
+sub get_modules {
+ my ($modalias) = @_;
+ my ($class) = $modalias =~ /^([^:]+):\S+$/;
+ my ($vendor, $device) = alias_to_ids($modalias);
+ $class && member($class, @classes) or return;
+
+ require File::FnMatch;
+ foreach my $group (get_alias_groups()) {
+ my @aliases;
+ foreach my $subgroup ($group->{$class}{$vendor}{$device}, $group->{$class}{other}) {
+ foreach (group_by2(@$subgroup)) {
+ File::FnMatch::fnmatch($_->[0], $modalias) and push @aliases, $_->[1];
+ }
+ }
+ return uniq(@aliases) if @aliases;
+ }
+}
+
+1;