home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / ALF.pm next >
Text File  |  1998-07-31  |  10KB  |  380 lines
  1. package RISCOS::ALF::Time;
  2. use strict;
  3. use vars qw ($VERSION);
  4.  
  5. $VERSION = 0.01;
  6.  
  7. sub new ($$) {
  8.     my $proto = shift;
  9.     my $class = ref($proto) || $proto;
  10.     my $self  = {};
  11.     my ($data) = @_;
  12.     return undef unless defined ($data) && (length $data == 8);
  13.  
  14.     my ($t1, $micro, $t2) = unpack 'a4Sa2', $data;
  15.     # erk. Little endian short
  16.  
  17.     $self->{__TIME} = $t2 . $t1;
  18.     $self->{__MICRO} = $micro if $micro;    # Don't store it if it is zero
  19.     bless ($self, $class);
  20. }
  21.  
  22. sub Time {
  23.     my $self = shift;
  24.     $self->{__TIME};
  25. }
  26.  
  27. sub Micro {
  28.     my $self = shift;
  29.     $self->{__MICRO} ||= 0;
  30. }
  31.  
  32. sub TimeValid {
  33.     my $self = shift;
  34.     return 0 unless $self->{__TIME} =~ /[:-ÿ]\0$/s;    # 1980 to 2238
  35.     defined $self->{__MICRO} ? 1 : 2;    # Most valid if microseconds == 0
  36. }
  37.  
  38. package RISCOS::ALF::DirEntry;
  39.  
  40. use Carp;
  41. use strict;
  42. use vars qw (@ISA $VERSION);
  43.  
  44. $VERSION = 0.01;
  45. @ISA = qw();
  46.  
  47. # Pass a ref to scalar data, and an offset, or real data
  48. sub new ($$$;$$) {
  49.     my $proto = shift;
  50.     my $class = ref($proto) || $proto;
  51.     my $self  = {};
  52.     my ($chunkdata, $chunkfile, $length, $offset) = @_;
  53.  
  54.     return undef unless defined $chunkdata;
  55.     my $what = 'chunk';
  56.     if (ref $chunkdata eq 'SCALAR' or ref $chunkdata eq 'LVALUE') {
  57.     # Hmm, passed a reference into something bigger
  58.     if ($offset + 16 >= length $$chunkdata) {
  59.         return wantarray ? () : undef;    # OK, maybe not :-)
  60.     }
  61.     $what = 'reference';
  62.     $length = unpack 'V', substr $$chunkdata, $offset + 4, 4;
  63.     $chunkdata = substr $$chunkdata, $offset, $length;
  64.     }
  65.  
  66.     if ($^W and defined ($length) and length $chunkdata != $length) {
  67.     carp "${class}::new passed $what with length reported as " . $length
  68.       . ", actualy " . length $chunkdata;
  69.     }
  70.     $length = length $chunkdata;
  71.     carp "$class length $length is not a multiple of 4" if $^W and $length & 3;
  72.     if ($length < 16) {
  73.     carp "$class length $length < 16" if $^W;
  74.     return wantarray ? () : undef;
  75.     }
  76.     my ($chunkindex, $entrylen, $datalen, $data) = unpack 'V3a*', $chunkdata;
  77.  
  78.     if ($entrylen != $length) {
  79.     carp "$class entry reports length as $entrylen, data supplied is "
  80.       . $length if $^W;
  81.     return wantarray ? () : undef;
  82.     }
  83.     carp "$class data length of $datalen is too great for total length $length"
  84.       if ($^W && $datalen > ($entrylen - 12));
  85.  
  86.     return undef unless defined (my ($name) = $data =~ /^([^\0]*)/s);
  87.     $self->{__INDEX} = $chunkindex;
  88.     $self->{__NAME} = $name;
  89.     $self->{__CHUNK} = $chunkfile->By_Number ($chunkindex);
  90.  
  91.     my $time = new RISCOS::ALF::Time substr ($data, (length ($name) + 4) & ~3);
  92.     $self->{__TIME} = $time if defined $time;
  93.     
  94.     return bless ($self, $class) unless wantarray;
  95.     (bless ($self, $class), $length, $name)
  96. }
  97.  
  98. sub Name {
  99.     my $self = shift;
  100.     $self->{'__NAME'};
  101. }
  102.  
  103. sub Index {
  104.     my $self = shift;
  105.     $self->{'__INDEX'};
  106. }
  107.  
  108. sub Time {
  109.     my $self = shift;
  110.     $self->{'__TIME'};
  111. }
  112.  
  113. sub Chunk ($;$) {
  114.     my $self = shift;
  115.     my $chunk = $self->{'__CHUNK'};
  116.     $self->{'__CHUNK'} = $_[0] if defined $_[0];
  117.     $chunk;
  118. }
  119.  
  120. package RISCOS::ALF;
  121.  
  122. require RISCOS::Chunkfile;
  123. use Carp;
  124. use strict;
  125. use vars qw (@ISA $VERSION);
  126.  
  127. $VERSION = 0.02;
  128. @ISA = 'RISCOS::Chunkfile';
  129.  
  130. sub new ($$) {
  131.     my $proto = shift;
  132.     my $class = ref($proto) || $proto;
  133.     
  134.     my $self = $class->SUPER::new ($_[0]);
  135.     
  136.     foreach my $what (qw(LIB_DIRY LIB_TIME LIB_VSRN OFL_SYMT OFL_TIME)) {
  137.     if ($self->Multiple ($what)) {
  138.         carp "AOF file has '$what' chunks at positions "
  139.          . join (' ', @{$self->Lookup ($what)})
  140.           if $^W;
  141.         return undef;
  142.     }
  143.     }
  144.  
  145.     my $chunk = $self->Chunk ('LIB_VRSN');
  146.     
  147.     if (defined $chunk) {
  148.     my $version  = unpack 'I', $chunk->Data();
  149.     unless (4 == $chunk->Length) {
  150.         carp 'LIB_VRSN length ' . $chunk->Length() . ' != 4' if $^W;
  151.         return undef;
  152.     }
  153.     $self->{'__VERSION'} = $version;
  154.     }
  155.      
  156.     unless (defined ($chunk = $self->Chunk ('LIB_DIRY'))) {
  157.     carp "ALF file has no 'LIB_DIRY'" if $^W;
  158.     return undef;
  159.     }
  160.     
  161.     $chunk = \$chunk->Data;    # Ref to scalar data
  162.  
  163.     my $entries = {};
  164.     my ($position, $entry, $length, $name) = (0);
  165.     while ((($entry, $length, $name)
  166.           = new RISCOS::ALF::DirEntry $chunk, $self, undef, $position),
  167.         defined $entry) {
  168.     $entries->{$name} = $entry;
  169.     $position += $length
  170.     }
  171.     $self->{'__DIR'} = $entries;
  172.  
  173.     if (defined ($chunk = $self->Chunk ('LIB_TIME'))) {
  174.     my $time = new RISCOS::ALF::Time $chunk->Data;
  175.     $self->{'__TIME'} = $time if defined $time;
  176.     }
  177.     
  178.     if (defined ($chunk = $self->Chunk ('OFL_TIME'))) {
  179.     my $time = new RISCOS::ALF::Time $chunk->Data;
  180.     $self->{'__SYM_TIME'} = $time if defined $time;
  181.     }
  182.     $self;
  183. }
  184.  
  185. sub Dir ($) {
  186.     my $self = shift;
  187.     $self->{'__DIR'};
  188. }
  189.  
  190. sub Dir_Lookup ($$) {
  191.     my $self = shift;
  192.     $self->{'__DIR'}->{$_[0]};
  193. }
  194.  
  195. sub Time ($) {
  196.     my $self = shift;
  197.     $self->{'__TIME'};
  198. }
  199.  
  200. sub Sym_Time ($) {
  201.     my $self = shift;
  202.     $self->{'__TIME'};
  203. }
  204.  
  205. sub Version ($) {
  206.     my $self = shift;
  207.     $self->{'__VERSION'};
  208. }
  209.  
  210. 1;
  211. __END__
  212.  
  213. =head1 NAME
  214.  
  215. RISCOS::ALF -- manipulate Acorn Library Format files
  216.  
  217. =head1 SYNOPSIS
  218.  
  219.     use RISCOS::ALF;
  220.     
  221.     $library = new RISCOS::ALF $file;
  222.     print "Library file '$file':\n";
  223.     print '  ALF version ', $library->Version, "\n";
  224.  
  225. =head1 DESCRIPTION
  226.  
  227. C<RISCOS::ALF> provides a class derived from C<RISCOS::Chunkfile> to manipulate
  228. the contents of B<A>corn B<L>ibrary B<F>ormat files. It provides a classes
  229. C<RISCOS::ALF::Time> to manipulate 8 byte C<ALF> microsecond timestamps and
  230. C<RISCOS::ALF::DirEntry> to store details of each directory entry in an C<ALF>
  231. file.
  232.  
  233. Currently the implementation does not decode the library's symbol table.
  234.  
  235. =head2 Methods
  236.  
  237. =over 4
  238.  
  239. =item new <array_ref>
  240.  
  241. =item new <file>
  242.  
  243. If passed a reference to an array it is assumed to be an array of
  244. C<RISCOS::Chunk> objects to use as the file contents. Otherwise calls
  245. C<RISCOS::File::load> to loads the file specified using and checks that it is
  246. C<ALF>. Hence I<file> can be a filename, a reference to a filehandle, or a
  247. reference to a scalar which is used as the file's contents.
  248.  
  249. If passed an array reference then this is used internally in the object, so
  250. should be created with the anonymous array constructor C<[]> rather than a
  251. reference to a named array variable (see  L<perldsc/Common Mistakes>).
  252.  
  253. Returns undefined if there was an error, or the file contents are corrupt.
  254.  
  255. =item Dir
  256.  
  257. Returns a reference to the hash of C<RISCOS::ALF::DirEntry> objects describing
  258. the C<ALF> file's directory. The keys are member names, the values the objects.
  259.  
  260. =item Dir_Lookup <name>
  261.  
  262. Returns the C<RISCOS::ALF::DirEntry> object for I<name> in the C<ALF> file's
  263. directory.
  264.  
  265. =item Time
  266.  
  267. Returns the C<RISCOS::ALF::Time> object that gives the library timestamp - the
  268. time when the library was last modified.
  269.  
  270. =item Sym_Time
  271.  
  272. Returns the C<RISCOS::ALF::Time> object that gives the library symbol table
  273. timestamp (or undefined if there is no symbol table) - the time when the symbol
  274. table was last modified.
  275.  
  276. =item Version
  277.  
  278. Returns the version number of the C<ALF> library. The current version is 1.
  279.  
  280. =back
  281.  
  282. =head1 RISCOS::ALF::Time
  283.  
  284. The C<RISCOS::ALF::Time> class is used to hold 8 byte microsecond timestamps as
  285. used in C<ALF> libraries. It provides the following methods:
  286.  
  287. =over 4
  288.  
  289. =item new <packed_timestamp>
  290.  
  291. Creates a new C<RISCOS::ALF::Time> object from the 8 byte packed timestamp in an
  292. C<ALF> library.
  293.  
  294. =item Time
  295.  
  296. Returns the B<6> byte timestamp as centiseconds from the start of 1900. Assuming
  297. little endian byte order the last character should be C<"\0"> - chop this to get
  298. a standard B<5> byte RISCOS timestamp. Note that C<RISCOS::Time> functions will
  299. perform this conversion automatically.
  300.  
  301. =item Micro
  302.  
  303. Returns the microseconds field of the timestamp. This is usually 0.
  304.  
  305. =item TimeValid
  306.  
  307. Performs a sanity check on the time stored in the object. Returns:
  308.  
  309. =over 4
  310.  
  311. =item 0 if the date is outside the range (roughly) 1980 - 2238
  312.  
  313. =item 1 if the date is in this range but the microseconds field is non-zero
  314.  
  315. =item 2 if the date is in this range and the microseconds field is zero
  316.  
  317. =back
  318.  
  319. =back
  320.  
  321. =head1 RISCOS::ALF::DirEntry
  322.  
  323. The C<RISCOS::ALF::DirEntry> class is used to hold details of directory entries
  324. in C<ALF> libraries. It provides the following methods:
  325.  
  326. =over 4
  327.  
  328. =item new <scalar_reference>, <chunkfile>, undef, <offset>
  329.  
  330. =item new <file_data>, <chunkfile> ,<length>]
  331.  
  332. Creates a new C<RISCOS::ALF::DirEntry> from the supplied data. If passed a
  333. scalar this will be treated as being a single 'C<DATA>' item from a
  334. 'C<LIB_DIRY>' chunk in an C<ALF> file. I<length>, if defined, is used to verify
  335. the length recorded in the 'C<DATA>' item.
  336.  
  337. If passed a reference to a scalar, then this is dereferenced and the I<offset>
  338. parameter used to locate the 'C<DATA>' within this scalar. This allows an
  339. entire 'C<LIB_DIRY>' chunk to be converted with minimal string copying.
  340. (Remember that the length of a 'C<DATA>' item is unknown until decoding
  341. commences, so it is not possible to pass a substring to C<new> without I<a
  342. priori> knowledge of the length.)
  343.  
  344. I<chunkfile> is the C<RISCOS::Chunkfile> object that contains the chunk that
  345. this directory entry referes to.
  346.  
  347. In scalar context returns the object. In B<array context> returns
  348. C<(object, length, name)>. I<length> is added to the current I<offset> to
  349. calculate the offset of the next 'C<DATA>' item.
  350.  
  351. =item Name
  352.  
  353. Returns the name of this object, usually the file name whose contents form the
  354. data for this library member.
  355.  
  356. =item Index
  357.  
  358. Returns the index of the chunk which holds the data for this member.
  359.  
  360. =item Time
  361.  
  362. Returns the C<RISCOS::ALF::Time> object that gives the timestamp for this
  363. member. This is the last-modified time of the file whose contents form the data
  364. for this library member.
  365.  
  366. =item Chunk
  367.  
  368. Returns the C<RISCOS::Chunk> object for this entry.
  369.  
  370. =back
  371.  
  372. =head1 BUGS
  373.  
  374. As noted, methods to manipulate the library symbol table are currently
  375. unimplemented. Wildcard matching on library members is not implemented.
  376.  
  377. =head1 AUTHOR
  378.  
  379. Nicholas Clark <F<nick@unfortu.net>>
  380.