home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / RPC / !Perl / riscos / RISCOS / ROMModule.pm < prev    next >
Encoding:
Perl POD Document  |  1998-07-26  |  4.2 KB  |  200 lines
  1. package RISCOS::ROMModule;
  2.  
  3. use RISCOS::SWI;
  4. require Exporter;
  5. use strict;
  6. use vars qw (@ISA @EXPORT $VERSION %state $os_mods $mask);
  7.  
  8. @ISA = qw(Exporter);
  9. @EXPORT = qw(rommodules);
  10. $VERSION = 0.01;
  11.  
  12. %state = (
  13.     -1 => 'Unplugged',
  14.      0 => 'Dormant',
  15.      1 => 'Active',
  16.      2 => 'Running'
  17. );
  18.  
  19. $os_mods = SWINumberFromString("XOS_Module");
  20. $mask = ®mask([0..2],[1..6]);
  21.  
  22. sub silly_bcd ($)
  23. {
  24.     # Silly because it's a fix point fraction in BCD (duh)
  25.     # 3.70 is represented as 0x000370000
  26.     my $str = sprintf "%08x", $_[0];
  27.     $str =~ s/^(....)/$1./;    # Add a decimal point
  28.     $str =~ s/0{1,2}$//;    # Leave (at least) 2 decimal places
  29.     $str =~ s/^0{1,3}//;    # Strip leading zeros
  30.     $str;
  31. }
  32.  
  33. sub new {
  34.     my $proto = shift;
  35.     my $class = ref($proto) || $proto;
  36.     my $self  = {};
  37.     my $number = shift;
  38.     my $romno = shift;
  39.  
  40.     $number += 0;
  41.     $romno = -1 unless defined $romno;
  42.  
  43.     my ($nextm, $nextr, $name, $state, $chunk, $version)
  44.        = ('`'x4, 'a'x4, 'b'x4, 'c'x4, 'd'x4, 'e'x4);
  45.  
  46.     return undef unless swix ($os_mods, $mask, 20, $number, $romno,
  47.                   $nextm, $nextr, $name, $state, $chunk, $version);
  48.  
  49.     $self->{__MODNO} = -1 + unpack 'i', $nextm;
  50.     $self->{__ROM} = unpack 'i', $nextr;
  51.     $self->{__NAME} = unpack 'p', $name;
  52.     $self->{__STATE} = unpack 'i', $state;
  53.     $self->{__CHUNK} = unpack 'i', $chunk;
  54.     $self->{__VERSION} = silly_bcd (unpack ('i', $version));
  55.  
  56.     bless ($self, $class);
  57. }
  58.  
  59. sub Name {
  60.     my $self = shift;
  61.     $self->{'__NAME'};
  62. }
  63.  
  64. sub State {
  65.     my $self = shift;
  66.     $state{$self->{'__STATE'}};
  67.     # This would be a job for dualvar
  68. }
  69.  
  70. sub Chunk {
  71.     my $self = shift;
  72.     $self->{'__CHUNK'};
  73. }
  74.  
  75. sub Version {
  76.     my $self = shift;
  77.     $self->{'__VERSION'};
  78. }
  79.  
  80. sub ROM {
  81.     my $self = shift;
  82.     $self->{'__ROM'};
  83. }
  84.  
  85. sub Number {
  86.     my $self = shift;
  87.     $self->{'__MODNO'};
  88. }
  89.  
  90. sub Line {
  91.     my $self = shift;
  92.     sprintf "%3d %-12s%-23s%5s    $state{$self->{'__STATE'}}",
  93.         1 + $self->{'__MODNO'},
  94.         ($self->{'__ROM'} < 0) ? 'System ROM' : "Podule $self->{'__ROM'}",
  95.         $self->{'__NAME'}, $self->{'__VERSION'};
  96. }
  97.  
  98. sub rommodules () {
  99.     my @result;
  100.     my $romno = -1;
  101.     my $modno = 0;
  102.     my $mod;
  103.     while ($mod = new RISCOS::ROMModule ($modno, $romno))
  104.     {
  105.     push @result, $mod;
  106.     $modno = 1 + $mod->{__MODNO};
  107.     $romno = $mod->{__ROM};
  108.     }
  109.     @result;
  110. }
  111.  
  112. $os_mods;
  113.  
  114. __END__
  115.  
  116. =head1 NAME
  117.  
  118. RISCOS::ROMModule -- routines to enumerate the ROM modules
  119.  
  120. =head1 SYNOPSIS
  121.  
  122.     use RISCOS::ROMModule;
  123.  
  124.     @rommods = rommodules;
  125.  
  126.     foreach $mod (@rommods) {
  127.         print $mod->Line();
  128.     }
  129.  
  130. =head1 DESCRIPTION
  131.  
  132. C<RISCOS::ROMModule> provides a class to hold details about a module in ROM, and
  133. a subroutine C<rommodules> to enumerate all modules in ROM.
  134.  
  135. =head2 Methods
  136.  
  137. =over 4
  138.  
  139. =item new [<number>, [<rom>]]
  140.  
  141. Returns a new C<RISCOS::ROMModule> object with details of module I<number> in
  142. ROM I<rom>. I<number> defaults to C<0>, I<rom> to C<-1>.
  143.  
  144. Returns undefined if the specified module does not exist.
  145.  
  146. =item Name
  147.  
  148. Returns the name of the module.
  149.  
  150. =item State
  151.  
  152. Returns the state of the module - I<i.e.> 'Unplugged', 'Dormant', 'Active',
  153. 'Running'
  154.  
  155. Currently this is only a text string, but if the proposed C<DualVar> module
  156. becomes available this will return a dual-valued scalar with the string and
  157. the C<OS_Module 20> numeric code (-1, 0, 1, 2 respectively).
  158.  
  159. =item Chunk
  160.  
  161. Returns the chunk number for an expansion card module.
  162.  
  163. =item Version
  164.  
  165. Returns the version number of the module.
  166.  
  167. =item ROM
  168.  
  169. Returns the ROM number of the module. (Not the ROM number + 1 as returned by
  170. C<OS_Module 20>.) 
  171.  
  172. =item Number
  173.  
  174. Returns the number of the module in its ROM. (Not the ROM number + 1 as returned
  175. by C<OS_Module 20>.)
  176.  
  177. By calling new in turn with C<ROM> and C<Number> + 1 it is possible to enumerate
  178. all the modules in ROM, which is exactly what C<rommodules> does.
  179.  
  180. =item Line
  181.  
  182. Returns a line of text in the same format as the OS C<ROMModules> would, except
  183. that the formatting of the ROM numbers is correct (compare with RISC OS 3.70).
  184.  
  185. =back
  186.  
  187. =head2 rommodules
  188.  
  189. C<rommodules> returns an array of C<RISCOS::RomModule> objects corresponding to
  190. all modules in the System ROMs and any expansion cards, in the order returned
  191. by C<OS_Module 20>.
  192.  
  193. =head1 BUGS
  194.  
  195. None known.
  196.  
  197. =head1 AUTHOR
  198.  
  199. Nicholas Clark <F<nick@unfortu.net>>
  200.