root/Mac-Macbinary/trunk/Macbinary.pm

Revision 956 (checked in by miyagawa, 17 years ago)

0.05

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Mac::Macbinary;
2
3 use strict;
4 use vars qw($VERSION $AUTOLOAD);
5 $VERSION = 0.05;
6
7 use Carp ();
8
9 sub new {
10     my($class, $thingy, $attr) = @_;
11     my $self = bless {
12         validate => $attr->{validate},
13     }, $class;
14
15     my $fh = _make_handle($thingy);
16     $self->_parse_handle($fh);
17     return $self;
18 }
19
20 sub _parse_handle {
21     my $self = shift;
22     my($fh) = @_;
23
24     read $fh, my ($header), 128;
25     $self->{header} = Mac::Macbinary::Header->new($header, {
26         validate => $self->{validate},
27     });
28     read $fh, $self->{data}, $self->header->dflen;
29
30     my $resourceoffset = 128 - (($self->header->dflen) % 128);
31     read $fh, my($tmp), $resourceoffset;
32     read $fh, $self->{resource}, $self->header->rflen;
33
34     return $self;
35 }
36
37 sub _make_handle($) {
38     my $thingy = shift;
39    
40     if (-f $thingy && ! ref($thingy)) {
41         require FileHandle;
42         my $fh = FileHandle->new($thingy) or Carp::croak "$thingy: $!";
43         return $fh;
44     } else {
45         # tries to read it
46         eval {
47             read $thingy, my($tmp), 0;
48         };
49         if ($@) {
50           Carp::croak "Can't read $thingy!";
51         }
52         return $thingy;
53     }
54 }       
55
56 sub AUTOLOAD {
57     my $self = shift;
58     $AUTOLOAD =~ s/.*://o;
59     return $self->{$AUTOLOAD};
60 }
61
62
63 package Mac::Macbinary::Header;
64
65 use vars qw($AUTOLOAD);
66
67 sub new {
68     my($class, $h, $attr) = @_;
69     my $self = bless { }, $class;
70     if ($attr->{validate}) {
71         $self->_validate_header($h)
72             or Carp::croak "Macbinary validation failed.";
73     }
74     $self->_parse_header($h);
75     return $self;
76 }
77
78 sub _validate_header {
79     my $self = shift;
80     my($h) = @_;
81
82     #  stolen from Mac::Conversions
83     #
84     #  Use a crude heuristic to decide whether or not a file is MacBinary.  The
85     #  first byte of any MacBinary file must be zero.  The second has to be
86     #  <= 63 according to the MacBinary II standard.  The 122nd and 123rd
87     #  each have to be >= 129.  This has about a 1/8000 chance of failing on
88     #  random bytes.  This seems to be all that mcvert does.  Unfortunately
89     #  we can't also check the checksum because the standard software (Stuffit
90     #  Deluxe, etc.) doesn't seem to checksum.
91    
92     my($zero,
93        $namelength,
94        $filename,
95        $type,
96        $creator,
97        $highflag,
98        $dum1,
99        $dum2,
100        $dum3,
101        $datalength,
102        $reslength,
103        $dum4,
104        $dum5,
105        $dum6,
106        $lowflag,
107        $dum7,
108        $dum8,
109        $version_this,
110        $version_needed,
111        $crc) = unpack("CCA63a4a4CxNnCxNNNNnCx14NnCCN", $h);
112
113     return (!$zero && (($namelength - 1)< 63)
114             && $version_this >= 129 && $version_needed >= 129);
115 }
116
117 sub _parse_header {
118     my $self = shift;
119     my($h) = @_;
120
121     $self->{name}       = unpack("A*", substr($h, 2, 63));
122     $self->{type}       = unpack("A*", substr($h, 65, 4));
123     $self->{creator}    = unpack("A*", substr($h, 69, 4));
124     $self->{flags}      = unpack("C", substr($h, 73, 1));
125     $self->{location}   = unpack("C", substr($h, 80, 6));
126     $self->{dflen}      = unpack("N", substr($h, 83, 4));
127     $self->{rflen}      = unpack("N", substr($h, 87, 4));
128     $self->{cdate}      = unpack("N", substr($h, 91, 4));
129     $self->{mdate}      = unpack("N", substr($h, 95, 4));
130
131     return $self;
132 }
133
134
135 sub AUTOLOAD {
136     my $self = shift;
137     $AUTOLOAD =~ s/.*://o;
138     return $self->{$AUTOLOAD};
139 }
140
141 1;
142 __END__
143
144 =head1 NAME
145
146 Mac::Macbinary - Decodes Macbinary files
147
148 =head1 SYNOPSIS
149
150   use Mac::Macbinary;
151
152   $mb = Mac::Macbinary->new(\*FH);      # filehandle
153   $mb = Mac::Macbinary->new($fh);       # IO::* instance
154   $mb = Mac::Macbinary->new("/path/to/file");
155
156   # do validation
157   eval {
158       $mb = Mac::Macbinary->new("/path/to/file", { validate => 1 });
159   };
160
161   $header = $mb->header;                # Mac::Macbinary::Header instance
162   $name = $header->name;
163  
164
165 =head1 DESCRIPTION
166
167 This module provides an object-oriented way to extract various kinds
168 of information from Macintosh Macbinary files.
169
170 =head1 METHODS
171
172 Following methods are available.
173
174 =head2 Class method
175
176 =over 4
177
178 =item new( THINGY, [ \%attr ] )
179
180 Constructor of Mac::Macbinary. Accepts filhandle GLOB reference,
181 FileHandle instance, IO::* instance, or whatever objects that can do
182 C<read> methods.
183
184 If the argument belongs none of those above, C<new()> treats it as a
185 path to file. Any of following examples are valid constructors.
186
187   open FH, "path/to/file";
188   $mb = Mac::Macbinary->new(\*FH);
189
190   $fh = FileHandle->new("path/to/file");
191   $mb = Mac::Macbinary->new($fh);
192
193   $io = IO::File->new("path/to/file");
194   $mb = Mac::Macbinary->new($io);
195
196   $mb = Mac::Macbinary->new("path/to/file");
197
198 C<new()> throws an exception "Can't read blahblah" if the given
199 argument to the constructor is neither a valid filehandle nor an
200 existing file.
201
202 The optional L<\%attr> parameter can be used for validation of file
203 format.  You can check and see if a file is really a Macbinary or not
204 by setting "validate" attribute to 1.
205
206   $fh = FileHandle->new("path/to/file");
207   eval {
208       $mb = Mac::Macbinary->new(FileHandle->new($fh), {
209            validate => 1,
210       });
211   };
212   if ($@) {
213       warn "file is not a Macbinary.";
214   }
215
216 =back
217
218 =head2 Instance Method
219
220 =over 4
221
222 =item data
223
224 returns the data range of original file.
225
226 =item header
227
228 returns the header object (instance of Mac::Macbinary::Header).
229
230 =back
231
232 Following accessors are available via Mac::Macbinary::Header instance.
233
234 =over 4
235
236 =item name, type, creator, flags, location, dflen, rflen, cdate, mdate
237
238 returns the original entry in the header of Macbinary file.
239 Below is a structure of the info file, taken from MacBin.C
240
241   char zero1;
242   char nlen;
243   char name[63];
244   char type[4];           65      0101
245   char creator[4];        69
246   char flags;             73
247   char zero2;             74      0112
248   char location[6];       80
249   char protected;         81      0121
250   char zero3;             82      0122
251   char dflen[4];
252   char rflen[4];
253   char cdate[4];
254   char mdate[4];
255
256 =back
257
258 =head1 EXAMPLE
259
260 Some versions of MSIE for Macintosh sends their local files as
261 Macbinary format via forms. You can decode them in a following way:
262
263   use CGI;
264   use Mac::Macbinary;
265
266   $q = new CGI;
267   $filename = $q->param('uploaded_file');
268   $type = $q->uploadInfo($filename)->{'Content-Type'};
269  
270   if ($type eq 'application/x-macbinary') {
271       $mb = Mac::Macbinary->new($q->upload('uploaded_file'));
272       # now, you can get data via $mb->data;
273   }
274
275 =head1 COPYRIGHT
276
277 Copyright 2000 Tatsuhiko Miyagawa <miyagawa@bulknews.net>
278
279 This library is free software; you can redistribute it and/or
280 modify it under the same terms as Perl itself.
281
282 =head1 ACKNOWLEDGEMENT
283
284 Macbinary.pm is originally written by Dan Kogai <dankogai@dan.co.jp>.
285
286 There are also C<Mac::Conversions> and C<Convert::BinHex>, working
287 kind similar to this module. (However, C<Mac::Conversions> works only
288 on MacPerl, and C<Convert::BinHex> is now deprecated.) Many thanks to
289 Paul J. Schinder and Eryq, authors of those ones.
290
291 Macbinary validation is almost a replication of B<is_macbinary> in
292 Mac::Conversions.
293
294 =head1 SEE ALSO
295
296 perl(1), L<Mac::Conversions>, L<Convert::BinHex>.
297
298 =cut
299
300
Note: See TracBrowser for help on using the browser.