diff options
author | Mystery Man <unknown@mandriva.org> | 2000-11-08 00:01:16 +0000 |
---|---|---|
committer | Mystery Man <unknown@mandriva.org> | 2000-11-08 00:01:16 +0000 |
commit | d5c526273db473a7d87a26000585900fc10dda7d (patch) | |
tree | 0fdaabe7a00921b6cc556601b103d344fc7ac781 /perl-install/sbus_probing/main.pm | |
parent | 9c164312d4bfff6d93e1c4529de6b992f2bebc44 (diff) | |
download | drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar.gz drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar.bz2 drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar.xz drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.zip |
This commit was manufactured by cvs2svn to create branch
'unlabeled-1.1.1'.
Diffstat (limited to 'perl-install/sbus_probing/main.pm')
-rw-r--r-- | perl-install/sbus_probing/main.pm | 47 |
1 files changed, 33 insertions, 14 deletions
diff --git a/perl-install/sbus_probing/main.pm b/perl-install/sbus_probing/main.pm index f226eeea8..fa40160ae 100644 --- a/perl-install/sbus_probing/main.pm +++ b/perl-install/sbus_probing/main.pm @@ -2,7 +2,6 @@ package sbus_probing::main; use c; use log; -use modules; my %sbus_table_network = ( hme => [ "Sun Happy Meal Ethernet", "sunhme" ], @@ -65,14 +64,13 @@ my %sbus_table_video = ( 1; -sub prom_getint($) { unpack "I", c::prom_getproperty($_[0]) } - -#- update $@sbus_probed according to SBUS detection. +#- update %sbus_probed according to SBUS detection. sub prom_walk($$$$) { my ($sbus_probed, $node, $sbus, $ebus) = @_; - my ($prob_name, $prob_type) = (c::prom_getstring("name"), c::prom_getstring("device_type")); + my ($prob_name, $prob_type) = (c::prom_getproperty("name"), c::prom_getproperty("device_type")); my ($nextnode, $nsbus, $nebus) = (undef, $sbus, $ebus); + log::l("sbus probe at $node => $prob_name of type $prob_type on $sbus,$ebus"); #- probe for network devices. if ($sbus && $prob_type eq 'network') { $prob_name =~ s/[A-Z,]*(.*)/$1/; @@ -98,9 +96,9 @@ sub prom_walk($$$$) { #- probe for video devices. if ($prob_type eq 'display' && ($sbus || $prob_name =~ /^(ffb|afb|cgfourteen)$/)) { $prob_name =~ s/[A-Z,]*(.*)/$1/; - my $ext = ($prob_name eq 'mgx' && prom_getint('fb_size') == 0x400000 && '_4M' || + my $ext = ($prob_name eq 'mgx' && c::prom_getint('fb_size') == 0x400000 && '_4M' || $prob_name eq 'cgsix' && do { - my ($chiprev, $vmsize) = (prom_getint('chiprev'), prom_getint('vmsize')); + my ($chiprev, $vmsize) = (c::prom_getint('chiprev'), c::prom_getint('vmsize')); my $result = ''; $chiprev >= 1 && $chiprev <= 4 and $result = '_dbl'; $chiprev >= 5 && $chiprev <= 9 and $result = '_sgl'; @@ -109,10 +107,10 @@ sub prom_walk($$$$) { $chiprev == 11 && !$result and $result = '_t'; $result; } || - $prob_name eq 'leo' && c::prom_getstring('model') =~ /501-2503/ && '_t' || - $prob_name eq 'tcx' && c::prom_getbool('tcx-8-bit') && '_8b' || - $prob_name eq 'afb' && sprintf "_btx%x", prom_getint('board_type') || - $prob_name eq 'ffb' && sprintf "_btx%x", prom_getint('board_type')); + $prob_name eq 'leo' && c::prom_getproperty('model') =~ /501-2503/ && '_t' || + $prob_name eq 'tcx' && c::prom_getboot('tcx-8-bit') && '_8b' || + $prob_name eq 'afb' && sprintf "_btx%x", c::prom_getint('board_type') || + $prob_name eq 'ffb' && sprintf "_btx%x", c::prom_getint('board_type')); $sbus_table_video{$prob_name . $ext} ? push @$sbus_probed, [ "VIDEO", @{$sbus_table_video{$prob_name . $ext}} ] : @@ -126,12 +124,33 @@ sub prom_walk($$$$) { $nextnode = c::prom_getsibling($node) and prom_walk($sbus_probed, $nextnode, $sbus, $ebus); } -sub probe { - eval { modules::load("openprom") }; +sub check { + my $ok = $_[0] !~ /unknown/; + $ok or log::l("skipping $text, no module available (if you know one, please mail bugs\@linux-mandrake.com)"); + $ok +} + +sub probe($) { + my ($type) = @_; + + my $root_node = c::prom_open(); + my @l; + + prom_walk(\@l, $root_node, 0, 0); + c::prom_close(); + + $type eq '.' ? @l : map { [ @$_[1..$#$_] ] } grep { !$type || $_->[0] =~ /$type/i } @l; +} + +sub matching_desc($;$) { + my ($regexp) = @_; + my $root_node = c::prom_open(); my @l; prom_walk(\@l, $root_node, 0, 0); c::prom_close(); - map { my %l; @l{qw(type description drivers)} = @$_ } @l; + grep { !$type || $_->[1] =~ /$regexp/ } @l; } + +sub list { map { "$_->[1] ($_->[0] $_->[2])" } probe('.'); } |