home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / Chunkfile.pm < prev    next >
Text File  |  1998-07-31  |  7KB  |  247 lines
  1. package RISCOS::Chunkfile;
  2.  
  3. require Exporter;
  4. use RISCOS::File 0.02 qw(load);
  5. use RISCOS::Chunk;
  6. use Carp;
  7. use strict;
  8. use vars qw ($VERSION);
  9.  
  10. $VERSION = 0.04;
  11.  
  12. sub new ($) {
  13.     my $proto = shift;
  14.     my $class = ref($proto) || $proto;
  15.     my $chunks;
  16.  
  17.     if (ref($_[0]) eq 'ARRAY') {
  18.     $chunks = shift;
  19.     } elsif (ref($_[0]) eq 'RISCOS::Chunkfile') {
  20.     $chunks = shift->Chunks();
  21.     } else {
  22.     my $file = &load;    # Pass on our arguments
  23.     unless (defined $file) {
  24.         carp 'Could not load file' if $^W;
  25.         return undef;
  26.     }
  27.     my ($tag, $maxchunks, $numchunks) = unpack 'V3', $file;
  28.  
  29.     if ($tag != 0xC3CBC6C5) {
  30.         carp 'Not a chunk file' if $^W;
  31.         return undef;
  32.     }
  33.  
  34.     if (length $file < 12 + 16 * $maxchunks) {
  35.         carp sprintf ('Chunk file with $maxchunks entries expected to be '
  36.               . '%d, actually %d', (12 + 16 * $maxchunks),
  37.               length $file)
  38.           if $^W;
  39.         return undef;
  40.     }
  41.         
  42.     $chunks = [];
  43.  
  44. #    @$chunks = $numchunks;
  45.  
  46.     for (my $chunk = 0; $chunk < $maxchunks; $chunk++) {
  47.         my ($chunkid, $offset, $size) =
  48.           unpack 'A8V2', substr $file, 12 + 16 * $chunk, 16;
  49.     
  50.         if ($offset) {
  51.         carp "Used chunk '$chunkid' at $maxchunks - expected only "
  52.              . "$numchunks used" if ($chunk >= $numchunks);
  53.         } else {
  54.         if ($chunk < $numchunks) {
  55.             carp "Unused chunk $maxchunks - expected $numchunks used";
  56.         } else {
  57.             next;    # Unused
  58.         }
  59.         }
  60.     
  61.         push @$chunks, new RISCOS::Chunk $chunkid,
  62.                          substr ($file, $offset, $size),
  63.                          $size, $chunk, $offset;
  64.     }
  65.     }
  66.  
  67.     my $self  = {};
  68.     my $hash  = {};
  69.     $self->{'CHUNKS'} = $chunks;
  70.     
  71.     my $index = @$chunks;
  72.     
  73.     while ($index--) {
  74.     my $chunk = $chunks->[$index];
  75.     unshift @{$$hash{$chunk->ID}}, $index;
  76.     # Erk ! :-)
  77.     # It's a reference to a hash
  78.     # The hash keys are the ID's
  79.     # The hash entries are reference to arrays of all the chunks where this
  80.     # ID can be found
  81.     }
  82.  
  83.     $self->{'INDEX'} = $hash;
  84.  
  85.     bless ($self, $class);
  86. }    # Would you believe that apart from missing this } this beastie worked
  87.     # first time!
  88.  
  89. sub Chunks ($) {
  90.     my $self = shift;
  91.     $self->{'CHUNKS'};
  92. }
  93.  
  94. sub Index ($) {
  95.     my $self = shift;
  96.     $self->{'INDEX'};
  97. }
  98.  
  99. sub Lookup ($$) {
  100.     my $self = shift;
  101.     my $index = $self->{'INDEX'};
  102.     $index->{$_[0]};
  103. }
  104.  
  105. sub By_Number ($$) {
  106.     my $self = shift;
  107.     $self->{'CHUNKS'}->[$_[0]];
  108. }
  109. sub Single ($$) {
  110.     my $self = shift;
  111.     my $index = $self->{'INDEX'};
  112.     my $array = $index->{$_[0]};
  113.     
  114.     return (@$array == 1) ? $array->[0] : undef;
  115. }
  116.  
  117. sub Multiple ($$) {
  118.     my $self = shift;
  119.     my $index = $self->{'INDEX'};
  120.     my $array = $index->{$_[0]};
  121.     
  122.     return (defined $array and @$array > 1) ? @$array : ();
  123. }
  124.  
  125. sub Chunk ($$) {
  126.     my $self = shift;
  127.     my $index = $self->{'INDEX'};
  128.     my $array = $index->{$_[0]};
  129.  
  130.     return (defined $array and @$array == 1) ? $self->{'CHUNKS'}->[$array->[0]] 
  131.                          : undef;
  132. }
  133.  
  134. 1;
  135. __END__
  136.  
  137. =head1 NAME
  138.  
  139. RISCOS::Chunkfile -- class for manipulating Acorn chunkfiles (AOF & ALF)
  140.  
  141. =head1 SYNOPSIS
  142.  
  143.     use RISCOS::Chunkfile;
  144.     my $chunks = new RISCOS::Chunkfile $file;
  145.  
  146. =head1 DESCRIPTION
  147.  
  148. C<RISCOS::Chunkfile> provides a class for manipulating Acorn chunkfiles
  149. (I<e.g.> I<AOF> - B<A>RM B<O>bject B<F>ormat and I<ALF> - B<A>corn B<L>ibrary
  150. B<F>ormat). Currently this module is only used by the AOF and ALF modules.
  151.  
  152. C<RISCOS::Chunkfile> provides the following methods:
  153.  
  154. =over 4
  155.  
  156. =item new <array_ref>
  157.  
  158. =item new <file>
  159.  
  160. If passed a reference to an array it is assumed to be an array of
  161. C<RISCOS::Chunk> objects to use as the file contents. Otherwise calls
  162. C<RISCOS::File::load> to loads the file specified using and checks that it is a
  163. chunkfile. Hence I<file> can be a filename, a reference to a filehandle, or a
  164. reference to a scalar which is used as the file's contents.
  165.  
  166. If passed an array reference then this is used internally in the object, so
  167. should be created with the anonymous array constructor C<[]> rather than a
  168. reference to a named array variable (see  L<perldsc/Common Mistakes>).
  169.  
  170. Returns undefined if there was an error, or the file contents are corrupt.
  171.  
  172. =item Chunks
  173.  
  174. Returns a reference to the array of C<RISCOS::Chunk> objects, which are in the
  175. same order as found in the file. Treat this as B<read only>. Changing the order
  176. or number of the chunks will confuse all the other lookup methods. If you need
  177. to manipulate the chunks pass this array back to C<new> to create a new
  178. chunkfile object, and delete the old object (most simply by reusing the same
  179. named variable).
  180.  
  181. =item Index
  182.  
  183. Returns a reference to a hash which indexes the array of C<RISCOS::Chunk>
  184. objects returned by C<chunks>. The hash keys are the textual chunk IDs from the
  185. chunk header, the hash entries are reference to arrays containing the numbers of
  186. all the chunks where this ID can be found. For most IDs the array referenced
  187. will have only one entry (for example an C<ALF> file will contain only one
  188. C<LIB_DIRY> for the library directory) but where an ID occurs multiple times in
  189. the chunk header the reference will be to an array of the indexes of all these
  190. chunks (I<e.g.> in an C<ALF> library each object file is stored in a C<LIB_DATA>
  191. chunk -  C<$index->{LIB_DATA}> will be a reference to the IDs of all of the
  192. chunks containing object files).
  193.  
  194. =item Lookup <chunkID>
  195.  
  196. Returns a reference to the array of chunk indexes in the file where this chunk
  197. ID is present. Effectively the value from a lookup on the hash returned by
  198. C<Keys>, so will return undefined if no chunks in the file have this chunk ID.
  199.  
  200. =item By_Number <chunk_index>
  201.  
  202. Returns the C<RISCOS::Chunk> object at I<chunk_index> position in the file.
  203. Effectively the value from the array returned by C<Chunks>.
  204.  
  205. =item Single <chunkID>
  206.  
  207. Returns the index of the only chunk in the file with ID I<chunkID>, or undefined
  208. if zero or multiple chunks have this ID.
  209.  
  210. =item Multiple <chunkID> {
  211.  
  212. Returns the list of chunks in the file with ID I<chunkID>, or an empty list if
  213. if less than two chunks have this ID.
  214.  
  215. =item Chunk <chunkID>
  216.  
  217. Returns the actual chunk of the only chunk in the file with ID I<chunkID>, or
  218. undefined if zero or multiple chunks have this ID.
  219.  
  220. Effectively a call to C<By_Number> with the value returned from C<Single>
  221.  
  222. =back
  223.  
  224. =head1 EXAMPLE
  225.  
  226. To display the index of chunks in a chunkfile
  227.  
  228.     use RISCOS::Chunkfile;
  229.     
  230.     my $chunks = new RISCOS::Chunkfile $file;
  231.     
  232.     print "$file:\n";
  233.     
  234.     foreach my $id (sort keys %{$chunks->Index})
  235.     {
  236.     print "\t$id\t", join (' ', @{$chunks->Lookup ($id)}), "\n";
  237.     }
  238.  
  239. =head1 BUGS
  240.  
  241. At present there is no standard way to return errors/diagnostics to the caller.
  242. Currently C<new> will call C<warn> if warnings are turned on.
  243.  
  244. =head1 AUTHOR
  245.  
  246. Nicholas Clark <F<nick@unfortu.net>>
  247.