home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Non-RPC
/
!Perl
/
riscos
/
RISCOS
/
ROMModule.pm
< prev
next >
Wrap
Text File
|
1998-07-26
|
4KB
|
200 lines
package RISCOS::ROMModule;
use RISCOS::SWI;
require Exporter;
use strict;
use vars qw (@ISA @EXPORT $VERSION %state $os_mods $mask);
@ISA = qw(Exporter);
@EXPORT = qw(rommodules);
$VERSION = 0.01;
%state = (
-1 => 'Unplugged',
0 => 'Dormant',
1 => 'Active',
2 => 'Running'
);
$os_mods = SWINumberFromString("XOS_Module");
$mask = ®mask([0..2],[1..6]);
sub silly_bcd ($)
{
# Silly because it's a fix point fraction in BCD (duh)
# 3.70 is represented as 0x000370000
my $str = sprintf "%08x", $_[0];
$str =~ s/^(....)/$1./; # Add a decimal point
$str =~ s/0{1,2}$//; # Leave (at least) 2 decimal places
$str =~ s/^0{1,3}//; # Strip leading zeros
$str;
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
my $number = shift;
my $romno = shift;
$number += 0;
$romno = -1 unless defined $romno;
my ($nextm, $nextr, $name, $state, $chunk, $version)
= ('`'x4, 'a'x4, 'b'x4, 'c'x4, 'd'x4, 'e'x4);
return undef unless swix ($os_mods, $mask, 20, $number, $romno,
$nextm, $nextr, $name, $state, $chunk, $version);
$self->{__MODNO} = -1 + unpack 'i', $nextm;
$self->{__ROM} = unpack 'i', $nextr;
$self->{__NAME} = unpack 'p', $name;
$self->{__STATE} = unpack 'i', $state;
$self->{__CHUNK} = unpack 'i', $chunk;
$self->{__VERSION} = silly_bcd (unpack ('i', $version));
bless ($self, $class);
}
sub Name {
my $self = shift;
$self->{'__NAME'};
}
sub State {
my $self = shift;
$state{$self->{'__STATE'}};
# This would be a job for dualvar
}
sub Chunk {
my $self = shift;
$self->{'__CHUNK'};
}
sub Version {
my $self = shift;
$self->{'__VERSION'};
}
sub ROM {
my $self = shift;
$self->{'__ROM'};
}
sub Number {
my $self = shift;
$self->{'__MODNO'};
}
sub Line {
my $self = shift;
sprintf "%3d %-12s%-23s%5s $state{$self->{'__STATE'}}",
1 + $self->{'__MODNO'},
($self->{'__ROM'} < 0) ? 'System ROM' : "Podule $self->{'__ROM'}",
$self->{'__NAME'}, $self->{'__VERSION'};
}
sub rommodules () {
my @result;
my $romno = -1;
my $modno = 0;
my $mod;
while ($mod = new RISCOS::ROMModule ($modno, $romno))
{
push @result, $mod;
$modno = 1 + $mod->{__MODNO};
$romno = $mod->{__ROM};
}
@result;
}
$os_mods;
__END__
=head1 NAME
RISCOS::ROMModule -- routines to enumerate the ROM modules
=head1 SYNOPSIS
use RISCOS::ROMModule;
@rommods = rommodules;
foreach $mod (@rommods) {
print $mod->Line();
}
=head1 DESCRIPTION
C<RISCOS::ROMModule> provides a class to hold details about a module in ROM, and
a subroutine C<rommodules> to enumerate all modules in ROM.
=head2 Methods
=over 4
=item new [<number>, [<rom>]]
Returns a new C<RISCOS::ROMModule> object with details of module I<number> in
ROM I<rom>. I<number> defaults to C<0>, I<rom> to C<-1>.
Returns undefined if the specified module does not exist.
=item Name
Returns the name of the module.
=item State
Returns the state of the module - I<i.e.> 'Unplugged', 'Dormant', 'Active',
'Running'
Currently this is only a text string, but if the proposed C<DualVar> module
becomes available this will return a dual-valued scalar with the string and
the C<OS_Module 20> numeric code (-1, 0, 1, 2 respectively).
=item Chunk
Returns the chunk number for an expansion card module.
=item Version
Returns the version number of the module.
=item ROM
Returns the ROM number of the module. (Not the ROM number + 1 as returned by
C<OS_Module 20>.)
=item Number
Returns the number of the module in its ROM. (Not the ROM number + 1 as returned
by C<OS_Module 20>.)
By calling new in turn with C<ROM> and C<Number> + 1 it is possible to enumerate
all the modules in ROM, which is exactly what C<rommodules> does.
=item Line
Returns a line of text in the same format as the OS C<ROMModules> would, except
that the formatting of the ROM numbers is correct (compare with RISC OS 3.70).
=back
=head2 rommodules
C<rommodules> returns an array of C<RISCOS::RomModule> objects corresponding to
all modules in the System ROMs and any expansion cards, in the order returned
by C<OS_Module 20>.
=head1 BUGS
None known.
=head1 AUTHOR
Nicholas Clark <F<nick@unfortu.net>>