#!/usr/local/bin/perl package Mac::Conversions; require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(binhex debinhex macbinary demacbinary hex2macb macb2hex is_macbinary); $VERSION = "1.04"; sub Version { $VERSION; } use strict; use Convert::BinHex; use POSIX; use Fcntl; use File::Basename; use Carp; use FileHandle; sub new { my $class = shift; my %arg = @_; my %self = (); $self{Debug} = exists $arg{Debug} ? $arg{Debug} : 0; $self{Remove} = exists $arg{Remove} ? $arg{Remove} : 0; bless \%self, $class; } sub binhex { # # Native Mac to BinHex, using Convert::BinHex # use Mac::Files; my $bhex; my ($lname, $ldir, $has, $size, $rsize, $finfo, $outname, $flags, $i); my $self = shift; my $file = shift || croak("No filename given $!"); my $hqx = Convert::BinHex->new; ($lname,$ldir) = fileparse($file); $hqx->filename($lname); $outname = uniqify($ldir,$lname,"hqx"); $has = FSpGetCatInfo($file); $finfo = $has->ioFlFndrInfo; $size = $has->ioFlLgLen; $rsize = $has->ioFlRLgLen; $hqx->type($finfo->fdType); $hqx->creator($finfo->fdCreator); $flags = $finfo->fdFlags; $flags &= 0xfeff; #turn off inited bit $hqx->flags($flags); $hqx->data(Path => $file); $hqx->resource(Path => $file, Fork => "RSRC"); $hqx->data->length($size); $hqx->resource->length($rsize); if($self->{Debug}) { print "About to Binhex $file\n"; print "Resource size $rsize, data size $size\n"; } $bhex = FileHandle->new; $bhex->open($outname,"w") or croak("Unable to open $outname"); $hqx->encode($bhex); $bhex->close; } sub debinhex { # # BinHex to native Mac # use Mac::Files; my $bhex; my ($data, $testlength, $length,$lname,$ldir,$fd,$i); my $self = shift; my $file = shift || croak("No filename given $!"); $bhex = FileHandle->new; $bhex->open($file,"r") || croak("Unable to open $file: $!"); my $hqx = Convert::BinHex->open(FH => $bhex); $hqx->read_header; print $hqx->header_as_string if $self->{Debug}; my $outname = $hqx->filename; ($lname,$ldir) = fileparse($file); $outname = uniqify($ldir,$outname); FSpCreate($outname, $hqx->creator, $hqx->type) or croak("Unable to create Mac file $outname"); my $reslength = $hqx->resource_length; my $datalength = $hqx->data_length; $fd = POSIX::open($outname,&POSIX::O_WRONLY|&POSIX::O_CREAT,0755); $testlength = 0; while(defined($data = $hqx->read_data)) { $length = length($data); POSIX::write($fd,$data,$length) or croak("Couldn't write $length bytes: $!"); $testlength += $length; } POSIX::close($fd) or croak "Unable to close $outname"; croak("Data fork length mismatch, expected $datalength, wrote $testlength") if $datalength != $testlength; if($reslength) { $fd = POSIX::open($outname, &Fcntl::O_RSRC | &POSIX::O_WRONLY | &POSIX::O_CREAT,0755); $testlength = 0; while(defined($data = $hqx->read_resource)) { $length = length($data); POSIX::write($fd,$data,$length) or croak "Couldn't write $length bytes: $!"; $testlength += $length; } POSIX::close($fd) or croak "Unable to close $outname"; croak("Resource fork length mismatch, expected $reslength, wrote $testlength") if $testlength != $reslength; } my $has = FSpGetCatInfo($outname); my $finfo = $has->ioFlFndrInfo; $finfo->fdFlags($hqx->flags & 0xfeff); #turn off inited bit $finfo->fdType($hqx->type || "????"); $finfo->fdCreator($hqx->creator || "????"); if($self->{Debug}) { printf "Finder flags: %x\n",$finfo->fdFlags; print "File type: ",$finfo->fdType,"\n"; print "File creator: ",$finfo->fdCreator,"\n"; } $has->ioFlFndrInfo($finfo); FSpSetCatInfo($outname,$has) or croak "Unable to set catalog info $^E"; if($self->{Debug}) { $has = FSpGetCatInfo ($outname); printf "Finder flags for decoded file: %x\n",$has->ioFlFndrInfo->fdFlags; print "File type for decoded file: ",$has->ioFlFndrInfo->fdType,"\n"; print "File creator for decoded file: ",$has->ioFlFndrInfo->fdCreator,"\n"; } $bhex->close; if($self->{Remove}) { unlink($file) or warn("Unable to remove $file"); } } sub macbinary { # # Native Mac to MacBinary II # use Mac::Files; my ($macb,$in); my ($lname, $ldir, $has, $size, $rsize, $finfo, $outname, $flags,$buf, $n, $i); my $total; my $self = shift; my $file = shift || die "No filename given $!"; ($lname,$ldir) = fileparse($file); $outname = uniqify ($ldir,$lname,"bin"); $has = FSpGetCatInfo($file); $finfo = $has->ioFlFndrInfo; $size = $has->ioFlLgLen; $rsize = $has->ioFlRLgLen; $flags = $finfo->fdFlags; if($self->{Debug}) { print "About to MacBinary $file\n"; print "Resource size $rsize, data size $size\n"; } $macb = FileHandle->new; $macb->open($outname,"w") or croak("Unable to open $outname"); my $len = length($lname); $buf = pack("xCa63a4a4CxNnCxNNNNnCx14NnCC", $len, $lname, $finfo->fdType, $finfo->fdCreator, ($finfo->fdFlags & 0xff00) >> 8, $finfo->fdLocation, 0, # $finfo->fdFldr, 0, $size, $rsize, $has->ioFlCrDat, $has->ioFlMdDat, 0, $finfo->fdFlags & 0x00ff, 0, 0, 129, 129); syswrite $macb, $buf, 124; my $crc = 0; $crc = Convert::BinHex::macbinary_crc($buf,$crc); $crc &= 0xffff; $crc <<= 16; syswrite $macb, pack("N",$crc), 4; if($size) { $total = 0; print "Data Fork\n\n" if $self->{Debug}; $in = FileHandle->new; $in->open($file,"r") or die "Unable to open $file $!"; while($n = read $in,$buf,2048) { if ($n < 2048) { #assuming here that a file read from the file #system will always return the number of bytes #asked for. Probably true for local files, but #maybe not for networked disks. $n = syswrite $macb, $buf, length($buf); $total += $n; $n %= 128; if($n) { $n = 128 - $n; $buf = pack("x$n"); $n = syswrite $macb, $buf, $n; print "Writing $n nulls in last block, $total bytes already written\n" if $self->{Debug}; } } else { $n = syswrite $macb, $buf, 2048; $total += $n; } } $in->close; unless ($size == $total) { croak("Size mismatch in data fork: $total, $size"); } } if($rsize) { $total = 0; print "Resource Fork\n\n" if $self->{Debug}; my $fd = POSIX::open($file,&POSIX::O_RDONLY | &Fcntl::O_RSRC); while (($n = POSIX::read($fd, $buf, 2048)) > 0) { last unless defined $n; if ($n < 2048) { $n = syswrite $macb, $buf, length($buf); $total += $n; $n %= 128; if($n) { $n = 128 - $n; $buf = pack("x$n"); $n = syswrite $macb, $buf, $n; } } else { $n = syswrite $macb, $buf, 2048; $total += $n; } } POSIX::close($fd); unless ($rsize == $total) { croak("Size mismatch in resource fork: $total, $rsize"); } } $macb->close; } sub demacbinary { # # Take a MacBinary file and convert it to a native Mac file. # use Mac::Files; my ($macb,$data); my ($buf,$n,$i,$ldir,$lname); my $self = shift; my $file = shift or croak("No filename given $!"); $macb = FileHandle->new; $macb->open($file,"r") || croak("Unable to open $file: $!"); $n = read($macb,$buf,128); croak("Headerless MacBinary file, that shouldn't be!") unless $n == 128; my($namelength, $filename, $type, $creator, $highflag, $dum1, $dum2, $dum3, $datalength, $reslength, $dum4, $dum5, $dum6, $lowflag, $dum7, $dum8, $dum9, $dum10, $crc) = unpack("xCa63a4a4CxNnCxNNNNnCx14NnCCN",$buf); $filename = substr $filename, 0, $namelength; $crc >>= 16; #the CRC itself is in the first two bytes if($self->{Debug}) { print "Filename = $filename\nType = $type\nCreator = $creator\n"; print "Data Fork Length = $datalength\nResource Fork Length = $reslength\n"; printf("CRC = %x\n",$crc); } my $testcrc = Convert::BinHex::macbinary_crc(substr($buf,0,124)); $testcrc &= 0xffff; printf "Warning: checksum mismatch, %x, %x\n", $crc, $testcrc unless $crc == $testcrc; ($lname,$ldir) = fileparse($file); my $outname = uniqify($ldir,$filename); $data = FileHandle->new; $data->open($outname,"w") or croak("Unable to open the data fork of $outname"); my $counter = 0; my $tdatalength = $datalength; # # Since both the data and resouce forks are null padded to 128 byte boundaries, # I need to be careful to read a multiple of 128 from the MacBinary file, but # write only what is actually necessary to the native Mac file # if($datalength) { # # This complexity is here only for speed. The file could actually be read # 128 bytes at a time by the while loop alone. block_read is used because # of the padding of the MacBinary file. I don't want to get off a block # boundary, even though most of the time read() should just work. There's # no guarantee that you get what you ask for with read, though. # my $datacount = int($datalength/2048); for($i = 0;$i < $datacount;$i++) { $n = block_read($macb,\$buf,2048); syswrite($data,$buf,$n); #There should also be a safe_write $counter += $n; $tdatalength -= $n; } while ($tdatalength) { $n = block_read($macb,\$buf,128); $n = ($tdatalength > 128) ? 128 : $tdatalength; syswrite($data,$buf,$n); $tdatalength -= $n; $counter += $n; } } $data->close; croak("Data length written $counter != MacBinary data length $datalength") unless $counter == $datalength; # # Now do the resource fork # my $resfork = POSIX::open($outname, &POSIX::O_WRONLY|&Fcntl::O_RSRC |&POSIX::O_CREAT) or croak("Unable to open the resource fork of $outname"); $counter = 0; # # There's no need to worry about the null padding of the resource fork # because the resource fork is the last thing in the MacBinary file. # Simply read as many bytes as I need. # my $treslength = $reslength; if($reslength) { my $rescount = int($reslength/2048); for($i = 0;$i < $rescount;$i++) { $n = read($macb,$buf,2048); POSIX::write($resfork,$buf,$n); $counter += $n; $treslength -= $n; } read($macb,$buf,$treslength); POSIX::write($resfork,$buf,$treslength); $counter += $treslength; } POSIX::close($resfork) or croak("Unable to close $outname"); croak("Resource length written $counter != MacBinary resource length $reslength") unless $counter == $reslength; my $has = FSpGetCatInfo($outname); my $finfo = $has->ioFlFndrInfo; my $flag = (($highflag & 0xffff) << 8) + $lowflag; $finfo->fdFlags($flag & 0xfeff); #turn off inited bit $finfo->fdType($type || "????"); $finfo->fdCreator($creator || "????"); $has->ioFlFndrInfo($finfo); FSpSetCatInfo($outname,$has) or croak "Unable to set catalog info $^E"; $macb->close; if($self->{Remove}) { unlink($file) or warn("Unable to remove $file"); } } sub hex2macb { # # BinHex to MacBinary # my ($bhex,$macb); my ($data, $testlength, $length,$lname,$ldir,$fd,$buf,$i); my $self = shift; my $file = shift || croak("No filename given $!"); $bhex = FileHandle->new; $bhex->open($file,"r") || croak("Unable to open $file: $!"); my $hqx = Convert::BinHex->open(FH => $bhex); $hqx->read_header; my $outname = $hqx->filename; ($lname,$ldir) = fileparse($file); $outname = uniqify($ldir,$outname,"bin"); my $reslength = $hqx->resource_length; my $datalength = $hqx->data_length; $macb = FileHandle->new; $macb->open($outname,"w") or croak("Unable to open $outname"); $buf = pack("xCa63a4a4CxNnCxNNNNnCx14NnCC", length($hqx->filename), $hqx->filename, $hqx->type, $hqx->creator, ($hqx->flags & 0xfe00) >> 8, 0, 0, 0, $datalength, $reslength, 0, 0, 0, $hqx->flags & 0x00ff, 0, 0, 129, 129); syswrite $macb, $buf, 124; my $crc = 0; $crc = Convert::BinHex::macbinary_crc($buf,$crc); $crc &= 0xffff; printf("MacBinary CRC: %x\n",$crc) if $self->{Debug}; $crc <<= 16; syswrite $macb, pack("N",$crc), 4; $testlength = 0; while(defined($data = $hqx->read_data)) { $length = length($data); syswrite($macb,$data,$length) or croak("Couldn't write $length bytes: $!"); $testlength += $length; } croak("Data fork length mismatch, expected $datalength, wrote $testlength") if $datalength != $testlength; my $excess = $testlength % 128; if($excess) { $excess = 128 - $excess; $buf = pack("x$excess"); $length = syswrite $macb, $buf, $excess; } $testlength = 0; if($reslength) { while(defined($data = $hqx->read_resource)) { $length = length($data); syswrite($macb,$data,$length) or croak "Couldn't write $length bytes: $!"; $testlength += $length; } croak("Resource fork length mismatch, expected $reslength, wrote $testlength") if $testlength != $reslength; } $excess = $testlength % 128; if($excess) { $excess = 128 - $excess; $buf = pack("x$excess"); $length = syswrite $macb, $buf, $excess; } $macb->close; $bhex->close; if($self->{Remove}) { unlink($file) or warn("Unable to remove $file"); } } sub macb2hex { # # Take a MacBinary file and convert it to BinHex using Convert::BinHex. # my ($bhex,$macb,$tdata,$tres); my ($buf,$n,$i,$ldir,$lname); my $self = shift; my $file = shift or croak("No filename given $!"); $macb = FileHandle->new; $macb->open($file,"r") || croak("Unable to open $file: $!"); $n = read($macb,$buf,128); croak("Headerless MacBinary file, that shouldn't be!") unless $n == 128; my($namelength, $filename, $type, $creator, $highflag, $dum1, $dum2, $dum3, $datalength, $reslength, $dum4, $dum5, $dum6, $lowflag, $dum7, $dum8, $dum9, $dum10, $crc) = unpack("xCa63a4a4CxNnCxNNNNnCx14NnCCN",$buf); $filename = substr $filename, 0, $namelength; $crc >>= 16; #the CRC itself is in the first two bytes if($self->{Debug}) { print "Filename = $filename\nType = $type\nCreator = $creator\n"; print "Data Fork Length = $datalength\nResource Fork Length = $reslength\n"; printf("CRC = %x\n",$crc); } my $testcrc = Convert::BinHex::macbinary_crc(substr($buf,0,124)); $testcrc &= 0xffff; printf "Warning: checksum mismatch, %x, %x\n",$crc, $testcrc unless $crc == $testcrc; my $hqx = Convert::BinHex->new; ($lname,$ldir) = fileparse($file); my $outname = uniqify($ldir,$filename,"hqx"); # # Simplest way to do this with the tools available is to first create # two temporary files, one with the data fork, one with the resource fork # my $tdataname = uniqify($ldir,$filename,"datat"); $tdata = FileHandle->new; $tdata->open($tdataname,"w") or croak("Unable to open $tdataname"); my $counter = 0; my $tdatalength = $datalength; # # Since both the data and resouce forks are null padded to 128 byte boundaries, # I need to be careful to read a multiple of 128 from the MacBinary file, but # write only what is actually necessary to the temporary. # if($datalength) { # # This complexity is here only for speed. The file could actually be read # 128 bytes at a time by the while loop alone. block_read is used because # of the padding of the MacBinary file. I don't want to get off a block # boundary. # my $datacount = int($datalength/2048); for($i = 0;$i < $datacount;$i++) { $n = block_read($macb,\$buf,2048); syswrite($tdata,$buf,$n); #There should also be a safe_write $counter += $n; $tdatalength -= $n; } while ($tdatalength) { $n = block_read($macb,\$buf,128); $n = ($tdatalength > 128) ? 128 : $tdatalength; syswrite($tdata,$buf,$n); $tdatalength -= $n; $counter += $n; } } $tdata->close; croak("Data length written $counter != MacBinary data length $datalength") unless $counter == $datalength; my $tresname = uniqify($ldir,$filename,"rsrct"); $tres = FileHandle->new; $tres->open($tresname,"w"); $counter = 0; # # There's no need to worry about the null padding of the resource fork # because the resource fork is the last thing in the MacBinary file. # Simply read as many bytes as I need. # my $treslength = $reslength; if($reslength) { my $rescount = int($reslength/2048); for($i = 0;$i < $rescount;$i++) { $n = read($macb,$buf,2048); syswrite($tres,$buf,$n); $counter += $n; $treslength -= $n; } read($macb,$buf,$treslength); syswrite($tres,$buf,$treslength); $counter += $treslength; } $tres->close; croak("Resource length written $counter != MacBinary resource length $reslength") unless $counter == $reslength; $hqx->filename($filename); $hqx->creator($creator); $hqx->type($type); my $flag = (($highflag & 0xffff) << 8) + $lowflag; $hqx->flags($flag); $hqx->data->length($datalength); $hqx->resource->length($reslength); $hqx->resource(Path => $tresname); $hqx->data(Path => $tdataname); $bhex = FileHandle->new; $bhex->open($outname,"w"); $hqx->encode($bhex); unlink($tresname); unlink($tdataname); $bhex->close; $macb->close; if($self->{Remove}) { unlink($file) or warn("Unable to remove $file"); } } sub is_macbinary { # # Use a crude heuristic to decide whether or not a file is MacBinary. The # first byte of any MacBinary file must be zero. The second has to be # <= 63 according to the MacBinary II standard. The 122nd and 123rd # each have to be >= 129. This has about a 1/8000 chance of failing on # random bytes. This seems to be all that mcvert does. Unfortunately # we can't also check the checksum because the standard software (Stuffit # Deluxe, etc.) doesn't seem to checksum. # # my $buf; my $self = shift; my $file = shift; my $macb = FileHandle->new; $macb->open($file,"r") || croak("Unable to open $file: $!"); my $bytes = read($macb,$buf,128); $macb->close; if ($self->{Debug} && $bytes < 128) { print "is_macbinary only read $bytes header bytes\n"; } return 0 unless $bytes == 128; my($zero, $namelength, $filename, $type, $creator, $highflag, $dum1, $dum2, $dum3, $datalength, $reslength, $dum4, $dum5, $dum6, $lowflag, $dum7, $dum8, $version_this, $version_needed, $crc) = unpack("CCA63a4a4CxNnCxNNNNnCx14NnCCN",$buf); if ($self->{Debug}) { print "is_macbinary check bytes: $zero, $namelength, $version_this, $version_needed\n"; } if (!$zero && (($namelength -1 )< 63) && $version_this >= 129 && $version_needed >= 129) { return 1; } else { return 0; } } sub uniqify ($$;$) { my ($dir,$name,$ext) = @_; my $i; my $j = defined($ext) ? (length($ext) + 1) : 0; $name = substr($name,(-31 + $j)) if (length($name) > (31 - $j)); my $fullname = $j ? $dir.$name.".$ext" : $dir.$name; if(-e $fullname) { my $newname; for($i = 1;$i <= 100;$i++) { $newname = $j ? "$name.$i.$ext" : "$name.$i"; $newname = substr($newname,-31) if length($newname) > 31; last unless (-e $dir.$newname); } return $dir.$newname; } return $fullname; } sub block_read { # # Make sure that exactly the requested number of bytes gets read from a file, # and no less. If less get read, it's an error. MacBinary files are guaranteed # to be padded to 128 byte boundaries, so this prevents any data corruption # if the number of bytes requested are not obtained. # my($fh,$buf,$number) = @_; my $n = $number; my $m; $$buf = ""; my $buff = ""; my $count = 0; while($n) { $m = read($fh,$buff,$n); croak ("block_read: End of file reached prematurely") unless defined($m); $$buf .= $buff; $n -= $m; $count++; if($count > 100 ) { croak("block_read: Unable to read exactly $number bytes after 100 tries"); } } return $number; } 1; __END__ =head1 NAME Mac::Conversions - A package for common MacOS file encoding/decoding tasks =head1 SYNOPSIS use Mac::Conversions qw(binhex debinhex macbinary demacbinary macb2hex hex2macb); $converter = Mac::Conversions->new; $converter->binhex("path:to:MacPerl"); $converter->debinhex("path:to:MacPerl.hqx"); $converter->macbinary("path:to:Shuck"); $converter->demacbinary("path:to:Shuck.bin"); $converter->macb2hex("path:to:MacPerl.hqx"); $converter->hex2macb("path:to:MacPerl.bin"); =head1 DESCRIPTION C is a class implementing converters for the types of file encoding/decoding routinely done when using MacOS. All of these rely on the presence of the C module, and C will not run if C is not installed. The conversions are: =over 4 =item C Take the native Macintosh file pointed to by $path and create a BinHex file in the same folder. If the native Macintosh file is named "name", the BinHex file is named "name.hqx", unless "name.hqx" already exists. Then C will attempt to find a unique name by inserting integers in the name, "name.0.hqx", "name.1.hqx", etc. =item C Take the BinHex file pointed to by $path and decode it to reconstruct the native Macintosh file. The name of the file will be that encoded into the BinHex file if a file of that name doesn't exist. Otherwise, a unique name will be constructed by adding integers after the name. =item C Take the native Macintosh file pointed to by $path and create a MacBinaryII file. The name of the MacBinary file will be "name.bin" if the native file is called "name", but C will try to find a unique name in the same way that C does if a file "name.bin" already exists. =item C The MacBinary II file pointed to by $path will be decoded to a native Macintosh file. The name of the file will be that encoded into the MacBinary file, except a unique name will be constructed if a file of that name already exists. =item C The BinHex file $path is converted to a MacBinary file. The name will be "name.bin", where name is the name of the file encoded in the BinHex file, with the usual caveat. =item C The MacBinary II file $path is converted to BinHex. =item C This routine uses a simple test to find out if a file is a MacBinary or not. Returns 1 if it is, 0 otherwise. This routine can be fooled, but should be correct almost all of the time. =item C The constructor for the class. If new is called with Debug => 1 $c = Mac::Conversions->new(Debug => 1); then semi-useful debugging information will be printed to standard output. If Remove => 1 is set, then the original BinHex or MacBinary (but never a native Mac file) will be unlinked. (Note this means that it doesn't simply get moved to the Trash but disappears forever.) =back =head1 SEE ALSO See the documentation for C, where all the heavy lifting is really done. =head1 COPYRIGHT Copyright 1999, Paul J. Schinder This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut