From 3c2245dbec33d3c60ca56e85edf56d19dcb510a6 Mon Sep 17 00:00:00 2001 From: Stephen Nelson Date: Tue, 20 Aug 2013 23:04:15 -0700 Subject: [PATCH] Initial import --- COPYING | 248 ++++ MANIFEST | 21 + Makefile.PL | 20 + README | 93 ++ README-TOO | 13 + bin/binhex.pl | 169 +++ bin/debinhex.pl | 211 +++ docs/Convert/BinHex.pm.html | 1059 +++++++++++++++ docs/Convert/BinHex/hqxred.gif | Bin 0 -> 1441 bytes docs/Convert/BinHex/redapple-sm.gif | Bin 0 -> 149 bytes docs/Convert/BinHex/redapple-tiny.gif | Bin 0 -> 82 bytes docs/Convert/BinHex/redapple.gif | Bin 0 -> 982 bytes lib/Convert/BinHex.pm | 1741 +++++++++++++++++++++++++ t/Checker.pm | 33 + t/comp2bin.t | 85 ++ test/hexbin | 81 ++ testin/eyeball.gif | Bin 0 -> 2755 bytes testin/eyeball.gif.hqx | 60 + testin/hands_m.eps.hqx | 1521 +++++++++++++++++++++ testin/pbs_mac.eps.hqx | 208 +++ testout/README | 1 + 21 files changed, 5564 insertions(+) create mode 100644 COPYING create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 README-TOO create mode 100644 bin/binhex.pl create mode 100644 bin/debinhex.pl create mode 100644 docs/Convert/BinHex.pm.html create mode 100644 docs/Convert/BinHex/hqxred.gif create mode 100644 docs/Convert/BinHex/redapple-sm.gif create mode 100644 docs/Convert/BinHex/redapple-tiny.gif create mode 100644 docs/Convert/BinHex/redapple.gif create mode 100644 lib/Convert/BinHex.pm create mode 100644 t/Checker.pm create mode 100644 t/comp2bin.t create mode 100644 test/hexbin create mode 100644 testin/eyeball.gif create mode 100644 testin/eyeball.gif.hqx create mode 100644 testin/hands_m.eps.hqx create mode 100644 testin/pbs_mac.eps.hqx create mode 100644 testout/README diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..3c68f02 --- /dev/null +++ b/COPYING @@ -0,0 +1,248 @@ + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..c046f8b --- /dev/null +++ b/MANIFEST @@ -0,0 +1,21 @@ +COPYING +MANIFEST +Makefile.PL +README +README-TOO +bin/binhex.pl +bin/debinhex.pl +docs/Convert/BinHex.pm.html +docs/Convert/BinHex/hqxred.gif +docs/Convert/BinHex/redapple-sm.gif +docs/Convert/BinHex/redapple-tiny.gif +docs/Convert/BinHex/redapple.gif +lib/Convert/BinHex.pm +t/Checker.pm +t/comp2bin.t +test/hexbin +testin/eyeball.gif +testin/eyeball.gif.hqx +testin/hands_m.eps.hqx +testin/pbs_mac.eps.hqx +testout/README diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..eecd8de --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,20 @@ +#!/usr/bin/perl +use ExtUtils::MakeMaker; + +#------------------------------------------------------------ +# Makefile: +#------------------------------------------------------------ + +# Write the Makefile: +WriteMakefile( + NAME => 'Convert::BinHex', + VERSION_FROM => "./lib/Convert/BinHex.pm", + DISTNAME => "Convert-BinHex", + EXE_FILES => [@EXES], + 'dist' => { + PREOP => "cd docs ; make", + COMPRESS => 'gzip', + SUFFIX => 'gz', + } + ); + diff --git a/README b/README new file mode 100644 index 0000000..4793d7a --- /dev/null +++ b/README @@ -0,0 +1,93 @@ +NAME + Convert::BinHex - extract data from Macintosh BinHex files + + *ALPHA WARNING: this code is currently in its Alpha release. Things may + change drastically until the interface is hammered out: if you have + suggestions or objections, please speak up now!* + +SYNOPSIS + Simple functions: + + use Convert::BinHex qw(binhex_crc macbinary_crc); + + # Compute HQX7-style CRC for data, pumping in old CRC if desired: + $crc = binhex_crc($data, $crc); + + # Compute the MacBinary-II-style CRC for the data: + $crc = macbinary_crc($data, $crc); + + + Hex to bin, low-level interface. Conversion is actually done via an + object (the section on "Convert::BinHex::Hex2Bin") which keeps internal + conversion state: + + # Create and use a "translator" object: + my $H2B = Convert::BinHex->hex2bin; # get a converter object + while () { + print $STDOUT $H2B->next($_); # convert some more input + } + print $STDOUT $H2B->done; # no more input: finish up + + + Hex to bin, OO interface. The following operations *must* be done in the + order shown! + + # Read data in piecemeal: + $HQX = Convert::BinHex->open(FH=>\*STDIN) || die "open: $!"; + $HQX->read_header; # read header info + @data = $HQX->read_data; # read in all the data + @rsrc = $HQX->read_resource; # read in all the resource + + + Bin to hex, low-level interface. Conversion is actually done via an + object (the section on "Convert::BinHex::Bin2Hex") which keeps internal + conversion state: + + # Create and use a "translator" object: + my $B2H = Convert::BinHex->bin2hex; # get a converter object + while () { + print $STDOUT $B2H->next($_); # convert some more input + } + print $STDOUT $B2H->done; # no more input: finish up + + + Bin to hex, file interface. Yes, you can convert *to* BinHex as well as + from it! + + # Create new, empty object: + my $HQX = Convert::BinHex->new; + + # Set header attributes: + $HQX->filename("logo.gif"); + $HQX->type("GIFA"); + $HQX->creator("CNVS"); + + # Give it the data and resource forks (either can be absent): + $HQX->data(Path => "/path/to/data"); # here, data is on disk + $HQX->resource(Data => $resourcefork); # here, resource is in core + + # Output as a BinHex stream, complete with leading comment: + $HQX->encode(\*STDOUT); + + + PLANNED!!!! Bin to hex, "CAP" interface. *Thanks to Ken Lunde for + suggesting this*. + + # Create new, empty object from CAP tree: + my $HQX = Convert::BinHex->from_cap("/path/to/root/file"); + $HQX->encode(\*STDOUT); + + +DESCRIPTION + BinHex is a format used by Macintosh for transporting Mac files safely + through electronic mail, as short-lined, 7-bit, semi-compressed data + streams. Ths module provides a means of converting those data streams + back into into binary data. + +CHANGES + Version 1.118 + + Ready to go public (with Paul's version, patched for native Mac + support)! Warnings have been suppressed in a few places where undefined + values appear. + diff --git a/README-TOO b/README-TOO new file mode 100644 index 0000000..10b6cbb --- /dev/null +++ b/README-TOO @@ -0,0 +1,13 @@ + +In this toolkit are the modules: + + Convert::BinHex (in ./lib) + +And the sample programs: + + binhex.pl (in ./bin) + debinhex.pl (in ./bin) + +Knock yourself out. + + diff --git a/bin/binhex.pl b/bin/binhex.pl new file mode 100644 index 0000000..5b7f8d2 --- /dev/null +++ b/bin/binhex.pl @@ -0,0 +1,169 @@ +#!/usr/bin/perl -w + + +=head1 NAME + +binhex.pl - use Convert::BinHex to encode files as BinHex + + +=head1 USAGE + +Usage: + + binhex.pl [options] file ... file + +Where the options are: + + -o dir Output in given directory (default outputs in file's directory) + -v Verbose output (normally just one line per file is shown) + +=head1 DESCRIPTION + +Each file is converted to file.hqx. + + +=head1 WARNINGS + +Largely untested. + + +=head1 AUTHOR + +Paul J. Schinder (NASA/GSFC) mostly, though Eryq can't seem to keep +his grubby paws off anything... + + +=cut + +use lib "./lib"; + +use Getopt::Std; +use Convert::BinHex; +use POSIX; +use Fcntl; +use File::Basename; +use Carp; +require Mac::Files if (($^O||'') eq "MacOS"); + +use strict; +use vars qw( + $opt_o + $opt_v +); + +my $DEBUG = 0; + +#------------------------------------------------------------ +# main +#------------------------------------------------------------ +sub main { + + # What usage? + @ARGV or usage(); + getopts('o:v'); + $DEBUG = $opt_v; + + # Process files: + my $file; + foreach $file (@ARGV) { + binhex($file); + } +} +exit(&main ? 0 : -1); + +#------------------------------------------------------------ +# usage +#------------------------------------------------------------ +# Get usage from me. + +sub usage { + my $msg = shift || ''; + my $usage = ''; + if (open(USAGE, "<$0")) { + while ($_ = and !/^=head1 USAGE/) {}; + while ($_ = and !/^=head1/) {$usage .= $_}; + close USAGE; + } + else { + $usage = "Usage unavailable; please see the script itself."; + } + print STDERR "\n$msg$usage"; + exit -1; +} + +#------------------------------------------------------------ +# binhex FILE +#------------------------------------------------------------ +# Encode the given FILE. +# +sub binhex { + my $inpath = shift || die "No filename given $!"; + local *BHEX; + my ($has, $dlength, $rlength, $finfo, $flags); + + # Create new BinHex interface: + my $hqx = Convert::BinHex->new; + + # Get input directory/filename: + my ($inname, $indir) = fileparse($inpath); + die "filename $inname too long!" if ((length($inname)+4) > 31); + $hqx->filename($inname); + + # Set up output directory/filename: + my $outname = "$inname.hqx"; + my $outdir = $opt_o || $indir; + my $outpath = "$outdir/$outname"; $outpath =~ s{/+}{/}g; + + # If we're on a Mac, we can get the real resource info: + if ($^O||'' eq "MacOS") { + + # Get and set up type, creator, flags: + $has = Mac::Files::FSpGetCatInfo($inpath); + $finfo = $has->{ioFlFndrInfo}; + $dlength = $has->{ioFlLgLen}; + $rlength = $has->{ioFlRLgLen}; + $hqx->type($finfo->{fdType}); + $hqx->creator($finfo->{fdCreator}); + $hqx->flags($finfo->{fdFlags} & 0xfeff); # turn off inited bit + + # Set up data fork: + $hqx->data(Path=>$inpath); + $hqx->data->length($dlength); + + # Set up resource fork: + $hqx->resource(Path=>$inpath, Fork => "RSRC"); + $hqx->resource->length($rlength); + } + else { # not a Mac: fake it... + # Set up data fork: + $hqx->data(Path => $inpath); + $dlength = (-s $inpath); + + # Set up resource fork: + if (-e "$inpath.rsrc") { + $hqx->resource(Path => "$inpath.rsrc"); + $rlength = (-s "$inpath.rsrc"); + } + else { + $hqx->resource(Data => ''); + $rlength = 0; + } + } + + # Ready! + print "BinHexing: $inpath\n"; + if ($DEBUG) { + print " Resource size: $rlength\n" if defined($rlength); + print " Data size: $dlength\n" if defined($dlength); + } + open BHEX, ">$outpath" or croak("Unable to open $outpath"); + $hqx->encode(\*BHEX); + close BHEX; + print "Wrote: $outpath\n"; +} +#------------------------------------------------------------ +1; + + + + diff --git a/bin/debinhex.pl b/bin/debinhex.pl new file mode 100644 index 0000000..5ea77da --- /dev/null +++ b/bin/debinhex.pl @@ -0,0 +1,211 @@ +#!/usr/bin/perl -w + + +=head1 NAME + +debinhex.pl - use Convert::BinHex to decode BinHex files + + +=head1 USAGE + +Usage: + + debinhex.pl [options] file ... file + +Where the options are: + + -o dir Output in given directory (default outputs in file's directory) + -v Verbose output (normally just one line per file is shown) + +=head1 DESCRIPTION + +Each file is expected to be a BinHex file. By default, the output file is +given the name that the BinHex file dictates, regardless of the name of +the BinHex file. + + +=head1 WARNINGS + +Largely untested. + + +=head1 AUTHOR + +Paul J. Schinder (NASA/GSFC) mostly, though Eryq can't seem to keep +his grubby paws off anything... + + +=cut + +use lib "./lib"; + +use Getopt::Std; +use Convert::BinHex; +use POSIX; +use Fcntl; +use File::Basename; +use Carp; +require Mac::Files if ($^O||'' eq "MacOS"); + +use strict; +use vars qw( + $opt_o + $opt_v +); + +my $DEBUG = 0; + +#------------------------------------------------------------ +# main +#------------------------------------------------------------ +sub main { + + # What usage? + @ARGV or usage(); + getopts('o:v'); + $DEBUG = $opt_v; + + # Process files: + my $file; + foreach $file (@ARGV) { + debinhex($file); + } +} +exit(&main ? 0 : -1); + +#------------------------------------------------------------ +# usage +#------------------------------------------------------------ +# Get usage from me. + +sub usage { + my $msg = shift || ''; + my $usage = ''; + if (open(USAGE, "<$0")) { + while ($_ = and !/^=head1 USAGE/) {}; + while ($_ = and !/^=head1/) {$usage .= $_}; + close USAGE; + } + else { + $usage = "Usage unavailable; please see the script itself."; + } + print STDERR "\n$msg$usage"; + exit -1; +} + +#------------------------------------------------------------ +# debinhex FILE +#------------------------------------------------------------ +# Decode the given FILE. +# +sub debinhex { + my $inpath = shift || croak("No filename given $!"); + local *BHEX; + my ($data, $testlength, $length, $fd); + + print "DeBinHexing: $inpath\n"; + + # Open BinHex file: + open(BHEX,"<$inpath") || croak("Unable to open $inpath: $!"); + + # Create converter interface on stream: + my $hqx = Convert::BinHex->open(FH => \*BHEX); + + # Read header, and output as string if debugging: + $hqx->read_header; + print $hqx->header_as_string if $DEBUG; + + # Get output directory/filename: + my ($inname, $indir) = fileparse($inpath); + my $outname = $hqx->filename || 'NONAME'; + my $outdir = $opt_o || $indir; + my $outpath = "$outdir/$outname"; $outpath =~ s{/+}{/}g; + + # Create Mac file: + if ($^O||'' eq "MacOS") { + Mac::Files::FSpCreate($outpath, $hqx->creator, $hqx->type) + or croak("Unable to create Mac file $outpath"); + } + + # Get lengths of forks: + my $dlength = $hqx->data_length; + my $rlength = $hqx->resource_length; + + # Write data fork: + print "Writing: $outpath\n"; + $fd = POSIX::open($outpath, (&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 $outpath"; + croak("Data fork length mismatch: ". + "expected $dlength, wrote $testlength") + if $dlength != $testlength; + + # Write resource fork? + if ($rlength) { + + # Determine how to open fork file appropriately: + my ($rpath, $rflags); + if (($^O||'') eq "MacOS") { + $rpath = $outpath; + $rflags = (&POSIX::O_WRONLY | &POSIX::O_CREAT | &Fcntl::O_RSRC); + } + else { + $rpath = "$outpath.rsrc"; + $rflags = (&POSIX::O_WRONLY | &POSIX::O_CREAT); + } + + # Write resource fork... + $fd = POSIX::open($rpath, $rflags, 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 $rpath"; + croak("Resource fork length mismatch: ". + "expected $rlength, wrote $testlength") + if $testlength != $rlength; + } + + # Set Mac attributes: + if (($^O||'') eq "MacOS") { + my $has = Mac::Files::FSpGetCatInfo($outpath); + my $finfo = $has->{ioFlFndrInfo}; + $finfo->{fdFlags} = $hqx->flags & 0xfeff; #turn off inited bit + $finfo->{fdType} = $hqx->type || "????"; + $finfo->{fdCreator} = $hqx->creator || "????"; + + # Turn on the bundle bit if it's an application: +### $finfo->{fdFlags} |= 0x2000 if $finfo->{fdType} eq "APPL"; + + if ($DEBUG) { + printf("%x\n",$finfo->{fdFlags}); + printf("%s\n",$finfo->{fdType}); + printf("%s\n",$finfo->{fdCreator}); + } + $has->{ioFlFndrInfo} = $finfo; + Mac::Files::FSpSetCatInfo($outpath, $has) + or croak "Unable to set catalog info $^E"; + if ($DEBUG) { + $has = Mac::Files::FSpGetCatInfo ($outpath); + printf("%x\n",$has->{ioFlFndrInfo}->{fdFlags}); + printf("%s\n",$has->{ioFlFndrInfo}->{fdType}); + printf("%s\n",$has->{ioFlFndrInfo}->{fdCreator}); + } + } + 1; +} + +#------------------------------------------------------------ +1; + + + diff --git a/docs/Convert/BinHex.pm.html b/docs/Convert/BinHex.pm.html new file mode 100644 index 0000000..d6b1415 --- /dev/null +++ b/docs/Convert/BinHex.pm.html @@ -0,0 +1,1059 @@ + + + + + +Convert::BinHex + + + + +
+

Convert::
BinHex

HQX
+		 + + +
+ +

+ +

+ +NAME

+ + + +

+Convert::BinHex - extract data from Macintosh BinHex files + + +

+ALPHA WARNING: this code is currently in its Alpha release. +Things may change drastically until the interface is hammered out: +if you have suggestions or objections, please speak up now! + + +

+ +

+ +SYNOPSIS

+ + + +

+Simple functions: + + +

+

    use Convert::BinHex qw(binhex_crc macbinary_crc);
+ + + +

+

    # Compute HQX7-style CRC for data, pumping in old CRC if desired:
+    $crc = binhex_crc($data, $crc);
+ + + +

+

    # Compute the MacBinary-II-style CRC for the data:
+    $crc = macbinary_crc($data, $crc);
+ + + +

+Hex to bin, low-level interface. +Conversion is actually done via an object ("Convert::BinHex::Hex2Bin") +which keeps internal conversion state: + + +

+

    # Create and use a "translator" object:
+    my $H2B = Convert::BinHex->hex2bin;    # get a converter object
+    while (<STDIN>) {
+	print $STDOUT $H2B->next($_);        # convert some more input
+    }
+    print $STDOUT $H2B->done;              # no more input: finish up
+ + + +

+Hex to bin, OO interface. +The following operations must be done in the order shown! + + +

+

    # Read data in piecemeal:
+    $HQX = Convert::BinHex->open(FH=>\*STDIN) || die "open: $!";
+    $HQX->read_header;                  # read header info
+    @data = $HQX->read_data;            # read in all the data
+    @rsrc = $HQX->read_resource;        # read in all the resource
+ + + +

+Bin to hex, low-level interface. +Conversion is actually done via an object ("Convert::BinHex::Bin2Hex") +which keeps internal conversion state: + + +

+

    # Create and use a "translator" object:
+    my $B2H = Convert::BinHex->bin2hex;    # get a converter object
+    while (<STDIN>) {
+	print $STDOUT $B2H->next($_);        # convert some more input
+    }
+    print $STDOUT $B2H->done;              # no more input: finish up
+ + + +

+Bin to hex, file interface. Yes, you can convert to BinHex +as well as from it! + + +

+

    # Create new, empty object:
+    my $HQX = Convert::BinHex->new;
+ + + +

+

    # Set header attributes:
+    $HQX->filename("logo.gif");
+    $HQX->type("GIFA");
+    $HQX->creator("CNVS");
+ + + +

+

    # Give it the data and resource forks (either can be absent):
+    $HQX->data(Path => "/path/to/data");       # here, data is on disk
+    $HQX->resource(Data => $resourcefork);     # here, resource is in core
+ + + +

+

    # Output as a BinHex stream, complete with leading comment:
+    $HQX->encode(\*STDOUT);
+ + + +

+PLANNED!!!! Bin to hex, "CAP" interface. +Thanks to Ken Lunde for suggesting this. + + +

+

    # Create new, empty object from CAP tree:
+    my $HQX = Convert::BinHex->from_cap("/path/to/root/file");
+    $HQX->encode(\*STDOUT);
+ + + +

+ +

+ +DESCRIPTION

+ + + +

+BinHex is a format used by Macintosh for transporting Mac files +safely through electronic mail, as short-lined, 7-bit, semi-compressed +data streams. Ths module provides a means of converting those +data streams back into into binary data. + + +

+ +

+ +FORMAT

+ + + +

+(Some text taken from RFC-1741.) +Files on the Macintosh consist of two parts, called forks: + +

+

Data fork
+ +The actual data included in the file. The Data fork is typically the +only meaningful part of a Macintosh file on a non-Macintosh computer system. +For example, if a Macintosh user wants to send a file of data to a +user on an IBM-PC, she would only send the Data fork. + + +

Resource fork
+ +Contains a collection of arbitrary attribute/value pairs, including +program segments, icon bitmaps, and parametric values. + +
+ +

+Additional information regarding Macintosh files is stored by the +Finder in a hidden file, called the "Desktop Database". + + +

+Because of the complications in storing different parts of a +Macintosh file in a non-Macintosh filesystem that only handles +consecutive data in one part, it is common to convert the Macintosh +file into some other format before transferring it over the network. +The BinHex format squashes that data into transmittable ASCII as follows: + +

    + +

  • 1. +The file is output as a byte stream consisting of some basic header +information (filename, type, creator), then the data fork, then the +resource fork. + + +

  • 2. +The byte stream is compressed by looking for series of duplicated +bytes and representing them using a special binary escape sequence +(of course, any occurences of the escape character must also be escaped). + + +

  • 3. +The compressed stream is encoded via the "6/8 hemiola" common +to base64 and uuencode: each group of three 8-bit bytes (24 bits) +is chopped into four 6-bit numbers, which are used as indexes into +an ASCII "alphabet". +(I assume that leftover bytes are zero-padded; documentation is thin). + +
+ +

+ +

+ +FUNCTIONS

+ + + +

+ +

+ +CRC computation

+ + +
+

macbinary_crc DATA, SEED
+ +Compute the MacBinary-II-style CRC for the given DATA, with the CRC +seeded to SEED. Normally, you start with a SEED of 0, and you pump in +the previous CRC as the SEED if you're handling a lot of data one chunk +at a time. That is: + + +

+

    $crc = 0;
+    while (<STDIN>) {
+        $crc = macbinary_crc($_, $crc);
+    }
+ + + +

+Note: Extracted from the mcvert utility (Doug Moore, April '87), +using a "magic array" algorithm by Jim Van Verth for efficiency. +Converted to Perl5 by Eryq. Untested. + + +

binhex_crc DATA, SEED
+ +Compute the HQX-style CRC for the given DATA, with the CRC seeded to SEED. +Normally, you start with a SEED of 0, and you pump in the previous CRC as +the SEED if you're handling a lot of data one chunk at a time. That is: + + +

+

    $crc = 0;
+    while (<STDIN>) {
+        $crc = binhex_crc($_, $crc);
+    }
+ + + +

+Note: Extracted from the mcvert utility (Doug Moore, April '87), +using a "magic array" algorithm by Jim Van Verth for efficiency. +Converted to Perl5 by Eryq. + +

+ +

+ +

+ +OO INTERFACE

+ + + +

+ +

+ +Conversion

+ + +
+

bin2hex
+ +Class method, constructor. +Return a converter object. Just creates a new instance of +"Convert::BinHex::Bin2Hex"; see that class for details. + + +

hex2bin
+ +Class method, constructor. +Return a converter object. Just creates a new instance of +"Convert::BinHex::Hex2Bin"; see that class for details. + +
+ +

+ +

+ +Construction

+ + +
+

new PARAMHASH
+ +Class method, constructor. +Return a handle on a BinHex'able entity. In general, the data and resource +forks for such an entity are stored in native format (binary) format. + + +

+Parameters in the PARAMHASH are the same as header-oriented method names, +and may be used to set attributes: + + +

+

    $HQX = new Convert::BinHex filename => "icon.gif",
+                               type    => "GIFB",
+                               creator => "CNVS";
+ + + +

open PARAMHASH
+ +Class method, constructor. +Return a handle on a new BinHex'ed stream, for parsing. +Params are: + +
+

Data
+ +Input a HEX stream from the given data. This can be a scalar, or a +reference to an array of scalars. + + +

Expr
+ +Input a HEX stream from any open()able expression. It will be opened and +binmode'd, and the filehandle will be closed either on a close() +or when the object is destructed. + + +

FH
+ +Input a HEX stream from the given filehandle. + + +

NoComment
+ +If true, the parser should not attempt to skip a leading "(This file...)" +comment. That means that the first nonwhite characters encountered +must be the binhex'ed data. + +
+
+ +

+ +

+ +Get/set header information

+ + +
+

creator [VALUE]
+ +Instance method. +Get/set the creator of the file. This is a four-character +string (though I don't know if it's guaranteed to be printable ASCII!) +that serves as part of the Macintosh's version of a MIME "content-type". + + +

+For example, a document created by "Canvas" might have +creator "CNVS". + + +

data [PARAMHASH]
+ +Instance method. +Get/set the data fork. Any arguments are passed into the +new() method of "Convert::BinHex::Fork". + + +

filename [VALUE]
+ +Instance method. +Get/set the name of the file. + + +

flags [VALUE]
+ +Instance method. +Return the flags, as an integer. Use bitmasking to get as the values +you need. + + +

header_as_string
+ +Return a stringified version of the header that you might +use for logging/debugging purposes. It looks like this: + + +

+

    X-HQX-Software: BinHex 4.0 (Convert::BinHex 1.102)
+    X-HQX-Filename: Something_new.eps
+    X-HQX-Version: 0
+    X-HQX-Type: EPSF
+    X-HQX-Creator: ART5
+    X-HQX-Data-Length: 49731
+    X-HQX-Rsrc-Length: 23096
+ + + +

+As some of you might have guessed, this is RFC-822-style, and +may be easily plunked down into the middle of a mail header, or +split into lines, etc. + + +

requires [VALUE]
+ +Instance method. +Get/set the software version required to convert this file, as +extracted from the comment that preceded the actual binhex'ed +data; e.g.: + + +

+

    (This file must be converted with BinHex 4.0)
+ + + +

+In this case, after parsing in the comment, the code: + + +

+

    $HQX->requires;
+ + + +

+would get back "4.0". + + +

resource [PARAMHASH]
+ +Instance method. +Get/set the resource fork. Any arguments are passed into the +new() method of "Convert::BinHex::Fork". + + +

type [VALUE]
+ +Instance method. +Get/set the type of the file. This is a four-character +string (though I don't know if it's guaranteed to be printable ASCII!) +that serves as part of the Macintosh's version of a MIME "content-type". + + +

+For example, a GIF89a file might have type "GF89". + + +

version [VALUE]
+ +Instance method. +Get/set the version, as an integer. + +
+ +

+ +

+ +Decode, high-level

+ + +
+

read_comment
+ +Instance method. +Skip past the opening comment in the file, which is of the form: + + +

+

   (This file must be converted with BinHex 4.0)
+ + + +

+As per RFC-1741, this comment must immediately precede the BinHex data, +and any text before it will be ignored. + + +

+You don't need to invoke this method yourself; read_header() will +do it for you. After the call, the version number in the comment is +accessible via the requires() method. + + +

read_header
+ +Instance method. +Read in the BinHex file header. You must do this first! + + +

read_data [NBYTES]
+ +Instance method. +Read information from the data fork. Use it in an array context to +slurp all the data into an array of scalars: + + +

+

    @data = $HQX->read_data;
+ + + +

+Or use it in a scalar context to get the data piecemeal: + + +

+

    while (defined($data = $HQX->read_data)) {
+       # do stuff with $data
+    }
+ + + +

+The NBYTES to read defaults to 2048. + + +

read_resource [NBYTES]
+ +Instance method. +Read in all/some of the resource fork. +See read_data() for usage. + +
+ +

+ +

+ +Encode, high-level

+ + +
+

encode OUT
+ +Encode the object as a BinHex stream to the given output handle OUT. +OUT can be a filehandle, or any blessed object that responds to a +print() message. + + +

+The leading comment is output, using the requires() attribute. + +

+ +

+ +

+ +SUBMODULES

+ + + +

+ +

+ +Convert::BinHex::Bin2Hex

+ + + +

+A BINary-to-HEX converter. This kind of conversion requires +a certain amount of state information; it cannot be done by +just calling a simple function repeatedly. Use it like this: + + +

+

    # Create and use a "translator" object:
+    my $B2H = Convert::BinHex->bin2hex;    # get a converter object
+    while (<STDIN>) {
+	print STDOUT $B2H->next($_);          # convert some more input
+    }
+    print STDOUT $B2H->done;               # no more input: finish up
+ + + +

+

    # Re-use the object:
+    $B2H->rewind;                 # ready for more action!
+    while (<MOREIN>) { ...
+ + + +

+On each iteration, next() (and done()) may return either +a decent-sized non-empty string (indicating that more converted data +is ready for you) or an empty string (indicating that the converter +is waiting to amass more input in its private buffers before handing +you more stuff to output. + + +

+Note that done() always converts and hands you whatever is left. + + +

+This may have been a good approach. It may not. Someday, the converter +may also allow you give it an object that responds to read(), or +a FileHandle, and it will do all the nasty buffer-filling on its own, +serving you stuff line by line: + + +

+

    # Someday, maybe...
+    my $B2H = Convert::BinHex->bin2hex(\*STDIN);
+    while (defined($_ = $B2H->getline)) {
+	print STDOUT $_;
+    }
+ + + +

+Someday, maybe. Feel free to voice your opinions. + + +

+ +

+ +Convert::BinHex::Hex2Bin

+ + + +

+A HEX-to-BINary converter. This kind of conversion requires +a certain amount of state information; it cannot be done by +just calling a simple function repeatedly. Use it like this: + + +

+

    # Create and use a "translator" object:
+    my $H2B = Convert::BinHex->hex2bin;    # get a converter object
+    while (<STDIN>) {
+	print STDOUT $H2B->next($_);          # convert some more input
+    }
+    print STDOUT $H2B->done;               # no more input: finish up
+ + + +

+

    # Re-use the object:
+    $H2B->rewind;                 # ready for more action!
+    while (<MOREIN>) { ...
+ + + +

+On each iteration, next() (and done()) may return either +a decent-sized non-empty string (indicating that more converted data +is ready for you) or an empty string (indicating that the converter +is waiting to amass more input in its private buffers before handing +you more stuff to output. + + +

+Note that done() always converts and hands you whatever is left. + + +

+Note that this converter does not find the initial +"BinHex version" comment. You have to skip that yourself. It +only handles data between the opening and closing ":". + + +

+ +

+ +Convert::BinHex::Fork

+ + + +

+A fork in a Macintosh file. + + +

+

    # How to get them...
+    $data_fork = $HQX->data;      # get the data fork
+    $rsrc_fork = $HQX->resource;  # get the resource fork
+ + + +

+

    # Make a new fork:
+    $FORK = Convert::BinHex::Fork->new(Path => "/tmp/file.data");
+    $FORK = Convert::BinHex::Fork->new(Data => $scalar);
+    $FORK = Convert::BinHex::Fork->new(Data => \@array_of_scalars);
+ + + +

+

    # Get/set the length of the data fork:
+    $len = $FORK->length;
+    $FORK->length(170);        # this overrides the REAL value: be careful!
+ + + +

+

    # Get/set the path to the underlying data (if in a disk file):
+    $path = $FORK->path;
+    $FORK->path("/tmp/file.data");
+ + + +

+

    # Get/set the in-core data itself, which may be a scalar or an arrayref:
+    $data = $FORK->data;
+    $FORK->data($scalar);
+    $FORK->data(\@array_of_scalars);
+ + + +

+

    # Get/set the CRC:
+    $crc = $FORK->crc;
+    $FORK->crc($crc);
+ + + +

+ +

+ +UNDER THE HOOD

+ + + +

+ +

+ +Design issues

+ + +
+

BinHex needs a stateful parser
+ +Unlike its cousins base64 and uuencode, BinHex format is not +amenable to being parsed line-by-line. There appears to be no +guarantee that lines contain 4n encoded characters... and even if there +is one, the BinHex compression algorithm interferes: even when you +can decode one line at a time, you can't necessarily +decompress a line at a time. + + +

+For example: a decoded line ending with the byte \x90 (the escape +or "mark" character) is ambiguous: depending on the next decoded byte, +it could mean a literal \x90 (if the next byte is a \x00), or +it could mean n-1 more repetitions of the previous character (if +the next byte is some nonzero n). + + +

+For this reason, a BinHex parser has to be somewhat stateful: you +cannot have code like this: + + +

+

    #### NO! #### NO! #### NO! #### NO! #### NO! ####
+    while (<STDIN>) {            # read HEX
+        print hexbin($_);          # convert and write BIN
+    }
+ + + +

+unless something is happening "behind the scenes" to keep track of +what was last done. The dangerous thing, however, is that this +approach will seem to work, if you only test it on BinHex files +which do not use compression and which have 4n HEX characters +on each line. + + +

+Since we have to be stateful anyway, we use the parser object to +keep our state. + + +

We need to be handle large input files
+ +Solutions that demand reading everything into core don't cut +it in my book. The first MPEG file that comes along can louse +up your whole day. So, there are no size limitations in this +module: the data is read on-demand, and filehandles are always +an option. + + +

Boy, is this slow!
+ +A lot of the byte-level manipulation that has to go on, particularly +the CRC computing (which involves intensive bit-shifting and masking) +slows this module down significantly. What is needed perhaps is an +optional extension library where the slow pieces can be done more +quickly... a Convert::BinHex::CRC, if you will. Volunteers, anyone? + + +

+Even considering that, however, it's slower than I'd like. I'm +sure many improvements can be made in the HEX-to-BIN end of things. +No doubt I'll attempt some as time goes on... + +

+ +

+ +

+ +How it works

+ + + +

+Since BinHex is a layered format, consisting of... + + +

+

      A Macintosh file [the "BIN"]...
+         Encoded as a structured 8-bit bytestream, then...
+            Compressed to reduce duplicate bytes, then...
+               Encoded as 7-bit ASCII [the "HEX"]
+ + + +

+...there is a layered parsing algorithm to reverse the process. +Basically, it works in a similar fashion to stdio's fread(): + + +

+

       0. There is an internal buffer of decompressed (BIN) data,
+          initially empty.
+       1. Application asks to read() n bytes of data from object
+       2. If the buffer is not full enough to accomodate the request:
+            2a. The read() method grabs the next available chunk of input
+                data (the HEX).
+            2b. HEX data is converted and decompressed into as many BIN
+                bytes as possible.
+            2c. BIN bytes are added to the read() buffer.
+            2d. Go back to step 2a. until the buffer is full enough
+                or we hit end-of-input.
+ + + +

+The conversion-and-decompression algorithms need their own internal +buffers and state (since the next input chunk may not contain all the +data needed for a complete conversion/decompression operation). +These are maintained in the object, so parsing two different +input streams simultaneously is possible. + + +

+ +

+ +WARNINGS

+ + + +

+Only handles Hqx7 files, as per RFC-1741. + + +

+Remember that Macintosh text files use "\r" as end-of-line: +this means that if you want a textual file to look normal on +a non-Mac system, you probably want to do this to the data: + + +

+

    # Get the data, and output it according to normal conventions:
+    foreach ($HQX->read_data) { s/\r/\n/g; print }
+ + + +

+ +

+ +CHANGE LOG

+ + + +

+Current version: $Id: BinHex.pm,v 1.119 1997/06/28 05:12:42 eryq Exp $ + +

+

Version 1.118
+ +Ready to go public (with Paul's version, patched for native Mac support)! +Warnings have been suppressed in a few places where undefined values +appear. + + +

Version 1.115
+ +Fixed another bug in comp2bin, related to the MARK falling on a +boundary between inputs. Added testing code. + + +

Version 1.114
+ +Added BIN-to-HEX conversion. Eh. It's a start. +Also, a lot of documentation additions and cleanups. +Some methods were also renamed. + + +

Version 1.103
+ +Fixed bug in decompression (wasn't saving last character). +Fixed "NoComment" bug. + + +

Version 1.102
+ +Initial release. + +
+ +

+ +

+ +AUTHOR AND CREDITS

+ + + +

+Written by Eryq, http://www.enteract.com/~eryq / eryq@enteract.com + + +

+Support for native-Mac conversion, plus invaluable contributions in +Alpha Testing, plus a few patches, plus the baseline binhex/debinhex +programs, were provided by Paul J. Schinder (NASA/GSFC). + + +

+Ken Lunde (Adobe) suggested incorporating the CAP file representation. + + +

+ +

+ +TERMS AND CONDITIONS

+ + + +

+Copyright (c) 1997 by Eryq. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms as +Perl itself. + + +

+This software comes with NO WARRANTY of any kind. +See the COPYING file in the distribution for details. + + +

+ + Apple Computer Corporation + neither endorses nor is in any way connected with + the development of this software. +

+ Last updated: Sat Jun 28 00:17:41 1997
+ Generated by pod2coolhtml 1.101. Want a copy? Just email + eryq@enteract.com. + (Yes, it's free.) + + diff --git a/docs/Convert/BinHex/hqxred.gif b/docs/Convert/BinHex/hqxred.gif new file mode 100644 index 0000000000000000000000000000000000000000..890b9f4d08e880e855d48ef4419a313e5668ba0a GIT binary patch literal 1441 zcmV;S1z!3`Nk%v~VQTknpsq@XW~AU|`T#Q25-?$S^3d006)k z5a4iV=)AbtczF2q@ZgMy$Vf=gaB$$Xu;8qq$Y@}|Ffh^9Aka`y@T8ys00000000000000000000000000000000000 z00000EC2ui0BZnW000L5K!9*aEEy3HU<6z!x9>c7aoP1bTc1et?3DPHhMX36Tm43zdqDm`9F~l9ZMQ znW06SkqMKP3zwpye+PV}ot~|$nXRv|ld`I`jAFU4rV3&LyrI66z>~wpna2vr!eY#r ze}}-4hr82n)wjUepxc5BUQJ|=E&&q@qvG+_6ZFQ`2_8&)bC$F zD-IkGYQt~;RZLXda;`Th(wrz#GJ7;A|=pgOdXLa39f-4sS-N3N!R>+GJPOF`Y z5!ZbSAuffvY$Yd9%s3pTVVO0H9vxU2zFwqLtJZva(dyT*fl0^|NkZ(~t1%@209C?W z+=wj*w~+cS)JS_1LcPEoIIQ6qFc87uJ&FV_1vZVTVPPY-My zs=D$OfD2C#9&!8G;@~?^fL^`i`y3@i)PDU%w_aUD@fDy019q3*fo&xyRX!PHpn-$_ zwWYy^75*M1M1>d1_h4NcYS5vFAclBbf%Oe1TmmJYc+dtLaDbtK{1xaT2Q(f*UvxuY zAjFT~0YD@c8xZ&)i%a%M1d-_(8RU;s0+~gUH%bSkbQU-{q?J_``DBz|3aJH_A}%=} zeO+!)rH^EWX{M2LUa6#d7TmR_dQOT7Czx^$*#(;CJ*Zd(dvcjUnMuSsCXjWWd8dJg zCMw*bjuw$=nSO3T=!%9`x?~4*0;*}JkD6*{mU)VbC#jo;*(j=5bnvNUF1}a_i>)fg zs|B#qD(j!ZQsDuOq*=NiuZJSKh_wfFN_nAHSAst2eud zXwJf+tg_5TSbN0?BT!uPe*1k)G0~}ZL4puO8x1nj&M93X)5C7@GyqXocr?|xS)Bpa z=bBMM3G%KBwsUEp-L%B3n;>VTTBMMI3Yb5R8|EskumYz-Q(-yhn%~B`=a|gHUFoFl&BE)UsD1&;>#4a8 zdnU5e-uelzvp`D=EtIIcWSCo?!tcRvI6Pv-TTY7$F1#T9^4C;n5--q8{{r>ESU*!S z*-y`XDc)}b!}+TZ&)oSisKb8xy03qJK+e7Qh^fx}JXF8g1qOfq z7Frf-x$GHrK va2_5c0tiLOKoYV*g(xI|3Qfqu{xR@{*NdSLhe*UC8u5roOrjFI5Ci}_n^~zR literal 0 HcmV?d00001 diff --git a/docs/Convert/BinHex/redapple-sm.gif b/docs/Convert/BinHex/redapple-sm.gif new file mode 100644 index 0000000000000000000000000000000000000000..6e1b75a2a440e8030b0dd8ec09838e03054cdc51 GIT binary patch literal 149 zcmZ?wbh9u|@A*Rf<=~++4onQz0JCi!QUCw| literal 0 HcmV?d00001 diff --git a/docs/Convert/BinHex/redapple.gif b/docs/Convert/BinHex/redapple.gif new file mode 100644 index 0000000000000000000000000000000000000000..e5eb6e886b8311f1bcf4f149b133eba1137c0986 GIT binary patch literal 982 zcmW+#JxG>O6h3JAN7zSGnvnzzc?@)j?C2?vpIdB-nmupv4$cW;$x|oZ*M8+GBHN-+ZBr+Mmf({S|Q&1yTVO3URb=KfiCz_!f;DHAK zyubmLsk&-pE`SR5X6mMqnF3}go2$D<<`IbEwuO3VWR}5ESP0Kx5?moRVN*6^bGG2r zQ|N|JD1#Jm2U&1IGjszy@Bn~14zS!TvH;)$s9^7Ik>vqXzzk&%i!2_5iS!T`@ltBu(gBrM?8M*-;c({%_4zME29s$4wP{BU3 zQNSEwa4;zt4a@>@2#0bQhjRp{vx2k{FY-iyNDL7n0hkCSfP;&$4X(fj2m?BlK?<0H z8n~btx&a=qaUFFWbar-5Oiawq&X!80h-giJK>8P|Yu;1THuWwxckQX$*D}(P>r$#Y z*njR%ZfE6bJzt+2{<^a|-Eic|_;CBq+VuW`=a+TaFxc{Ca_B*Q^IG%5dd0}chg)YB7lxn7=luAK zp%a_Mif{Rmw)@4c<%;#~$A@|VKNmNv>JDF>{xJBfR9W3P Unjf86T3LTxeS7sz+dQ594_{0A+W-In literal 0 HcmV?d00001 diff --git a/lib/Convert/BinHex.pm b/lib/Convert/BinHex.pm new file mode 100644 index 0000000..0b79dca --- /dev/null +++ b/lib/Convert/BinHex.pm @@ -0,0 +1,1741 @@ +package Convert::BinHex; + + +=head1 NAME + +Convert::BinHex - extract data from Macintosh BinHex files + +I + + +=head1 SYNOPSIS + +B + + use Convert::BinHex qw(binhex_crc macbinary_crc); + + # Compute HQX7-style CRC for data, pumping in old CRC if desired: + $crc = binhex_crc($data, $crc); + + # Compute the MacBinary-II-style CRC for the data: + $crc = macbinary_crc($data, $crc); + +B +Conversion is actually done via an object (L<"Convert::BinHex::Hex2Bin">) +which keeps internal conversion state: + + # Create and use a "translator" object: + my $H2B = Convert::BinHex->hex2bin; # get a converter object + while () { + print $STDOUT $H2B->next($_); # convert some more input + } + print $STDOUT $H2B->done; # no more input: finish up + +B +The following operations I be done in the order shown! + + # Read data in piecemeal: + $HQX = Convert::BinHex->open(FH=>\*STDIN) || die "open: $!"; + $HQX->read_header; # read header info + @data = $HQX->read_data; # read in all the data + @rsrc = $HQX->read_resource; # read in all the resource + +B +Conversion is actually done via an object (L<"Convert::BinHex::Bin2Hex">) +which keeps internal conversion state: + + # Create and use a "translator" object: + my $B2H = Convert::BinHex->bin2hex; # get a converter object + while () { + print $STDOUT $B2H->next($_); # convert some more input + } + print $STDOUT $B2H->done; # no more input: finish up + +B Yes, you can convert I BinHex +as well as from it! + + # Create new, empty object: + my $HQX = Convert::BinHex->new; + + # Set header attributes: + $HQX->filename("logo.gif"); + $HQX->type("GIFA"); + $HQX->creator("CNVS"); + + # Give it the data and resource forks (either can be absent): + $HQX->data(Path => "/path/to/data"); # here, data is on disk + $HQX->resource(Data => $resourcefork); # here, resource is in core + + # Output as a BinHex stream, complete with leading comment: + $HQX->encode(\*STDOUT); + +B +I. + + # Create new, empty object from CAP tree: + my $HQX = Convert::BinHex->from_cap("/path/to/root/file"); + $HQX->encode(\*STDOUT); + + +=head1 DESCRIPTION + +B is a format used by Macintosh for transporting Mac files +safely through electronic mail, as short-lined, 7-bit, semi-compressed +data streams. Ths module provides a means of converting those +data streams back into into binary data. + + +=head1 FORMAT + +I<(Some text taken from RFC-1741.)> +Files on the Macintosh consist of two parts, called I: + +=over 4 + +=item Data fork + +The actual data included in the file. The Data fork is typically the +only meaningful part of a Macintosh file on a non-Macintosh computer system. +For example, if a Macintosh user wants to send a file of data to a +user on an IBM-PC, she would only send the Data fork. + +=item Resource fork + +Contains a collection of arbitrary attribute/value pairs, including +program segments, icon bitmaps, and parametric values. + +=back + +Additional information regarding Macintosh files is stored by the +Finder in a hidden file, called the "Desktop Database". + +Because of the complications in storing different parts of a +Macintosh file in a non-Macintosh filesystem that only handles +consecutive data in one part, it is common to convert the Macintosh +file into some other format before transferring it over the network. +The BinHex format squashes that data into transmittable ASCII as follows: + +=over 4 + +=item 1. + +The file is output as a B consisting of some basic header +information (filename, type, creator), then the data fork, then the +resource fork. + +=item 2. + +The byte stream is B by looking for series of duplicated +bytes and representing them using a special binary escape sequence +(of course, any occurences of the escape character must also be escaped). + +=item 3. + +The compressed stream is B via the "6/8 hemiola" common +to I and I: each group of three 8-bit bytes (24 bits) +is chopped into four 6-bit numbers, which are used as indexes into +an ASCII "alphabet". +(I assume that leftover bytes are zero-padded; documentation is thin). + +=back + +=cut + +use strict; +use vars qw(@ISA @EXPORT_OK $VERSION $QUIET); +use integer; + +use Carp; +use Exporter; +use FileHandle; + +@ISA = qw(Exporter); +@EXPORT_OK = qw( + macbinary_crc + binhex_crc + ); + + + +# The package version, both in 1.23 style *and* usable by MakeMaker: +$VERSION = substr q$Revision: 1.119 $, 10; + +# My identity: +my $I = 'binhex:'; + +# Utility function: +sub min { + my ($a, $b) = @_; + ($a < $b) ? $a : $b; +} + +# An array useful for CRC calculations that use 0x1021 as the "seed": +my @MAGIC = ( + 0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7, + 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef, + 0x1231, 0x0210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6, + 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de, + 0x2462, 0x3443, 0x0420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485, + 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d, + 0x3653, 0x2672, 0x1611, 0x0630, 0x76d7, 0x66f6, 0x5695, 0x46b4, + 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc, + 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x0840, 0x1861, 0x2802, 0x3823, + 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b, + 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0x0a50, 0x3a33, 0x2a12, + 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a, + 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0x0c60, 0x1c41, + 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49, + 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0x0e70, + 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78, + 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f, + 0x1080, 0x00a1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067, + 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e, + 0x02b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256, + 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d, + 0x34e2, 0x24c3, 0x14a0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405, + 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c, + 0x26d3, 0x36f2, 0x0691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634, + 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab, + 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x08e1, 0x3882, 0x28a3, + 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a, + 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0x0af1, 0x1ad0, 0x2ab3, 0x3a92, + 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9, + 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0x0cc1, + 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8, + 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0x0ed1, 0x1ef0 +); + +# Ssssssssssshhhhhhhhhh: +$QUIET = 0; + + + +#============================== + +=head1 FUNCTIONS + +=head2 CRC computation + +=over 4 + +=cut + +#------------------------------------------------------------ + +=item macbinary_crc DATA, SEED + +Compute the MacBinary-II-style CRC for the given DATA, with the CRC +seeded to SEED. Normally, you start with a SEED of 0, and you pump in +the previous CRC as the SEED if you're handling a lot of data one chunk +at a time. That is: + + $crc = 0; + while () { + $crc = macbinary_crc($_, $crc); + } + +I Extracted from the I utility (Doug Moore, April '87), +using a "magic array" algorithm by Jim Van Verth for efficiency. +Converted to Perl5 by Eryq. B + +=cut + +sub macbinary_crc { + my $len = length($_[0]); + my $crc = $_[1]; + my $i; + for ($i = 0; $i < $len; $i++) { + ($crc ^= (vec($_[0], $i, 8) << 8)) &= 0xFFFF; + $crc = ($crc << 8) ^ $MAGIC[$crc >> 8]; + } + $crc; +} + +#------------------------------------------------------------ + +=item binhex_crc DATA, SEED + +Compute the HQX-style CRC for the given DATA, with the CRC seeded to SEED. +Normally, you start with a SEED of 0, and you pump in the previous CRC as +the SEED if you're handling a lot of data one chunk at a time. That is: + + $crc = 0; + while () { + $crc = binhex_crc($_, $crc); + } + +I Extracted from the I utility (Doug Moore, April '87), +using a "magic array" algorithm by Jim Van Verth for efficiency. +Converted to Perl5 by Eryq. + +=cut + +sub binhex_crc { + my $len = length($_[0]); + my $crc = $_[1]; + my $i; + for ($i = 0; $i < $len; $i++) { + my $ocrc = $crc; + $crc = (((($crc & 0xFF) << 8) | vec($_[0], $i, 8)) + ^ $MAGIC[$crc >> 8]) & 0xFFFF; + ## printf "CRCin = %04x, char = %02x (%c), CRCout = %04x\n", + ## $ocrc, vec($_[0], $i, 8), ord(substr($_[0], $i, 1)), $crc; + } + $crc; +} + + +=back + +=cut + + + +#============================== + +=head1 OO INTERFACE + +=head2 Conversion + +=over 4 + +=cut + +#------------------------------------------------------------ + +=item bin2hex + +I +Return a converter object. Just creates a new instance of +L<"Convert::BinHex::Bin2Hex">; see that class for details. + +=cut + +sub bin2hex { + return Convert::BinHex::Bin2Hex->new; +} + +#------------------------------------------------------------ + +=item hex2bin + +I +Return a converter object. Just creates a new instance of +L<"Convert::BinHex::Hex2Bin">; see that class for details. + +=cut + +sub hex2bin { + return Convert::BinHex::Hex2Bin->new; +} + +=back + +=cut + + + +#============================== + +=head2 Construction + +=over 4 + +=cut + +#------------------------------------------------------------ + +=item new PARAMHASH + +I +Return a handle on a BinHex'able entity. In general, the data and resource +forks for such an entity are stored in native format (binary) format. + +Parameters in the PARAMHASH are the same as header-oriented method names, +and may be used to set attributes: + + $HQX = new Convert::BinHex filename => "icon.gif", + type => "GIFB", + creator => "CNVS"; + +=cut + +sub new { + my ($class, %params) = @_; + + # Create object: + my $self = bless { + Data => new Convert::BinHex::Fork, # data fork + Rsrc => new Convert::BinHex::Fork, # resource fork + }, $class; # basic object + + # Process params: + my $method; + foreach $method (qw(creator filename flags requires type version + software_version)){ + $self->$method($params{$method}) if exists($params{$method}); + } + $self; +} + +#------------------------------------------------------------ + +=item open PARAMHASH + +I +Return a handle on a new BinHex'ed stream, for parsing. +Params are: + +=over 4 + +=item Data + +Input a HEX stream from the given data. This can be a scalar, or a +reference to an array of scalars. + +=item Expr + +Input a HEX stream from any open()able expression. It will be opened and +binmode'd, and the filehandle will be closed either on a C +or when the object is destructed. + +=item FH + +Input a HEX stream from the given filehandle. + +=item NoComment + +If true, the parser should not attempt to skip a leading "(This file...)" +comment. That means that the first nonwhite characters encountered +must be the binhex'ed data. + +=back + +=cut + +sub open { + my $self = shift; + my %params = @_; + + # Create object: + ref($self) or $self = $self->new; + + # Set up input: + my $data; + if ($params{FH}) { + $self->{FH} = Convert::BinHex::IO_Handle->wrap($params{FH}); + } + elsif ($params{Expr}) { + $self->{FH} = FileHandle->new($params{Expr}) or + croak "$I can't open $params{Expr}: $!\n"; + $self->{FH} = Convert::BinHex::IO_Handle->wrap($self->{FH}); + } + elsif ($params{Data}) { + if (!ref($data = $params{Data})) { # scalar + $self->{FH} = Convert::BinHex::IO_Scalar->wrap(\$data); + } + elsif (ref($data) eq 'ARRAY') { + $data = join('', @$data); + $self->{FH} = Convert::BinHex::IO_Scalar->wrap(\$data); + } + } + $self->{FH} or croak "$I missing a valid input source\n"; + + # Comments? + $self->{CommentRead} = $params{NoComment}; + + # Reset the converter! + $self->{H2B} = Convert::BinHex::Hex2Bin->new; + $self; +} + + +=back + +=cut + + + + +#============================== + +=head2 Get/set header information + +=over 4 + +=cut + +#------------------------------ + +=item creator [VALUE] + +I +Get/set the creator of the file. This is a four-character +string (though I don't know if it's guaranteed to be printable ASCII!) +that serves as part of the Macintosh's version of a MIME "content-type". + +For example, a document created by "Canvas" might have +creator C<"CNVS">. + +=cut + +sub creator { (@_ > 1) ? ($_[0]->{Creator} = $_[1]) : $_[0]->{Creator} } + +#------------------------------ + +=item data [PARAMHASH] + +I +Get/set the data fork. Any arguments are passed into the +new() method of L<"Convert::BinHex::Fork">. + +=cut + +sub data { + my $self = shift; + @_ ? $self->{Data} = Convert::BinHex::Fork->new(@_) : $self->{Data}; +} + +#------------------------------ + +=item filename [VALUE] + +I +Get/set the name of the file. + +=cut + +sub filename { (@_ > 1) ? ($_[0]->{Filename} = $_[1]) : $_[0]->{Filename} } + +#------------------------------ + +=item flags [VALUE] + +I +Return the flags, as an integer. Use bitmasking to get as the values +you need. + +=cut + +sub flags { (@_ > 1) ? ($_[0]->{Flags} = $_[1]) : $_[0]->{Flags} } + +#------------------------------ + +=item header_as_string + +Return a stringified version of the header that you might +use for logging/debugging purposes. It looks like this: + + X-HQX-Software: BinHex 4.0 (Convert::BinHex 1.102) + X-HQX-Filename: Something_new.eps + X-HQX-Version: 0 + X-HQX-Type: EPSF + X-HQX-Creator: ART5 + X-HQX-Data-Length: 49731 + X-HQX-Rsrc-Length: 23096 + +As some of you might have guessed, this is RFC-822-style, and +may be easily plunked down into the middle of a mail header, or +split into lines, etc. + +=cut + +sub header_as_string { + my $self = shift; + my @h; + push @h, "X-HQX-Software: " . + "BinHex " . ($self->requires || '4.0') . + " (Convert::BinHex $VERSION)"; + push @h, "X-HQX-Filename: " . $self->filename; + push @h, "X-HQX-Version: " . $self->version; + push @h, "X-HQX-Type: " . $self->type; + push @h, "X-HQX-Creator: " . $self->creator; + push @h, "X-HQX-Flags: " . sprintf("%x", $self->flags); + push @h, "X-HQX-Data-Length: " . $self->data->length; + push @h, "X-HQX-Rsrc-Length: " . $self->resource->length; + push @h, "X-HQX-CRC: " . sprintf("%x", $self->{HdrCRC}); + return join("\n", @h) . "\n"; +} + +#------------------------------ + +=item requires [VALUE] + +I +Get/set the software version required to convert this file, as +extracted from the comment that preceded the actual binhex'ed +data; e.g.: + + (This file must be converted with BinHex 4.0) + +In this case, after parsing in the comment, the code: + + $HQX->requires; + +would get back "4.0". + +=cut + +sub requires { + (@_ > 1) ? ($_[0]->{Requires} = $_[1]) : $_[0]->{Requires} +} +*software_version = \&requires; + +#------------------------------ + +=item resource [PARAMHASH] + +I +Get/set the resource fork. Any arguments are passed into the +new() method of L<"Convert::BinHex::Fork">. + +=cut + +sub resource { + my $self = shift; + @_ ? $self->{Rsrc} = Convert::BinHex::Fork->new(@_) : $self->{Rsrc}; +} + +#------------------------------ + +=item type [VALUE] + +I +Get/set the type of the file. This is a four-character +string (though I don't know if it's guaranteed to be printable ASCII!) +that serves as part of the Macintosh's version of a MIME "content-type". + +For example, a GIF89a file might have type C<"GF89">. + +=cut + +sub type { (@_ > 1) ? ($_[0]->{Type} = $_[1]) : $_[0]->{Type} } + +#------------------------------ + +=item version [VALUE] + +I +Get/set the version, as an integer. + +=cut + +sub version { (@_ > 1) ? ($_[0]->{Version} = $_[1]) : $_[0]->{Version} } + + +=back + +=cut + +### OBSOLETE!!! +sub data_length { shift->data->length(@_) } +sub resource_length { shift->resource->length(@_) } + + + + +#============================== + +=head2 Decode, high-level + +=over 4 + +=cut + +#------------------------------------------------------------ + +=item read_comment + +I +Skip past the opening comment in the file, which is of the form: + + (This file must be converted with BinHex 4.0) + +As per RFC-1741, I +and any text before it will be ignored. + +I C will +do it for you. After the call, the version number in the comment is +accessible via the C method. + +=cut + +sub read_comment { + my $self = shift; + return 1 if ($self->{CommentRead}); # prevent accidents + local($_); + while (defined($_ = $self->{FH}->getline)) { + chomp; + if (/^\(This file must be converted with BinHex ([\d\.]+).*\)\s*$/i) { + $self->requires($1); + return $self->{CommentRead} = 1; + } + } + croak "$I comment line (This file must be converted with BinHex...) ". + "not found\n"; +} + +#------------------------------------------------------------ + +=item read_header + +I +Read in the BinHex file header. You must do this first! + +=cut + +sub read_header { + my $self = shift; + return 1 if ($self->{HeaderRead}); # prevent accidents + + # Skip comment: + $self->read_comment; + + # Get header info: + $self->filename ($self->read_str($self->read_byte)); + $self->version ($self->read_byte); + $self->type ($self->read_str(4)); + $self->creator ($self->read_str(4)); + $self->flags ($self->read_short); + $self->data_length ($self->read_long); + $self->resource_length ($self->read_long); + $self->{HdrCRC} = $self->read_short; + $self->{HeaderRead} = 1; +} + +#------------------------------------------------------------ +# +# _read_fork +# +# I +# Read in a fork. +# + +sub _read_fork { + my $self = shift; + + # Pass in call if array context: + if (wantarray) { + local($_); + my @all; + push @all, $_ while (defined($_ = $self->_read_fork(@_))); + return @all; + } + + # Get args: + my ($fork, $n) = @_; + if($self->{$fork}->length == 0) { + $self->{$fork}->crc($self->read_short); + return undef; + } + defined($n) or $n = 2048; + + # Reset pointer into fork if necessary: + if (!defined($self->{$fork}{Ptr})) { + $self->{$fork}{Ptr} = 0; + $self->{CompCRC} = 0; + } + + # Check for EOF: + return undef if ($self->{$fork}{Ptr} >= $self->{$fork}->length); + + # Read up to, but not exceeding, the number of bytes left in the fork: + my $n2read = min($n, ($self->{$fork}->length - $self->{$fork}{Ptr})); + my $data = $self->read_str($n2read); + $self->{$fork}{Ptr} += length($data); + + # If we just read the last byte, read the CRC also: + if (($self->{$fork}{Ptr} == $self->{$fork}->length) && # last byte + !defined($self->{$fork}->crc)) { # no CRC + my $comp_CRC; + + # Move computed CRC forward by two zero bytes, and grab the value: + if ($self->{CheckCRC}) { + $self->{CompCRC} = binhex_crc("\000\000", $self->{CompCRC}); + } + + # Get CRC as stored in file: + $self->{$fork}->crc($self->read_short); # get stored CRC + + # Compare, and note corruption if detected: + if ($self->{CheckCRC} and ($self->{$fork}->crc != $comp_CRC)) { + &Carp::carp("CRCs do not match: corrupted data?") unless $QUIET; + $self->{Corrupted} = 1; + } + } + + # Return the bytes: + $data; +} + +#------------------------------------------------------------ + +=item read_data [NBYTES] + +I +Read information from the data fork. Use it in an array context to +slurp all the data into an array of scalars: + + @data = $HQX->read_data; + +Or use it in a scalar context to get the data piecemeal: + + while (defined($data = $HQX->read_data)) { + # do stuff with $data + } + +The NBYTES to read defaults to 2048. + +=cut + +sub read_data { + shift->_read_fork('Data',@_); +} + +#------------------------------------------------------------ + +=item read_resource [NBYTES] + +I +Read in all/some of the resource fork. +See C for usage. + +=cut + +sub read_resource { + shift->_read_fork('Rsrc',@_); +} + +=back + +=cut + + + +#------------------------------------------------------------ +# +# read BUFFER, NBYTES +# +# Read the next NBYTES (decompressed) bytes from the input stream +# into BUFFER. Returns the number of bytes actually read, and +# undef on end of file. +# +# I the calling style mirrors the IO::Handle read() function. + +my $READBUF = ''; +sub read { + my ($self, $n) = ($_[0], $_[2]); + $_[1] = ''; # just in case + my $FH = $self->{FH}; + local($^W) = 0; + + # Get more BIN bytes until enough or EOF: + my $bin; + while (length($self->{BIN_QUEUE}) < $n) { + $FH->read($READBUF, 4096) or last; + $self->{BIN_QUEUE} .= $self->{H2B}->next($READBUF); # save BIN + } + + # We've got as many bytes as we're gonna get: + $_[1] = substr($self->{BIN_QUEUE}, 0, $n); + $self->{BIN_QUEUE} = substr($self->{BIN_QUEUE}, $n); + + # Advance the CRC: + if ($self->{CheckCRC}) { + $self->{CompCRC} = binhex_crc($_[1], $self->{CompCRC}); + } + return length($_[1]); +} + +#------------------------------------------------------------ +# +# read_str NBYTES +# +# Read and return the next NBYTES bytes, or die with "unexpected end of file" + +sub read_str { + my ($self, $n) = @_; + my $buf = ''; + $self->read($buf, $n); + croak "$I unexpected end of file (wanted $n, got " . length($buf) . ")\n" + if ($n and (length($buf) < $n)); + return $buf; +} + +#------------------------------------------------------------ +# +# read_byte +# read_short +# read_long +# +# Read 1, 2, or 4 bytes, and return the value read as an unsigned integer. +# If not that many bytes remain, die with "unexpected end of file"; + +sub read_byte { + ord($_[0]->read_str(1)); +} + +sub read_short { + unpack("n", $_[0]->read_str(2)); +} + +sub read_long { + unpack("N", $_[0]->read_str(4)); +} + + + + + + + + + +#============================== + +=head2 Encode, high-level + +=over 4 + +=cut + +#------------------------------------------------------------ + +=item encode OUT + +Encode the object as a BinHex stream to the given output handle OUT. +OUT can be a filehandle, or any blessed object that responds to a +C message. + +The leading comment is output, using the C attribute. + +=cut + +sub encode { + my $self = shift; + + # Get output handle: + my $OUT = shift; $OUT = wrap Convert::BinHex::IO_Handle $OUT; + + # Get a new converter: + my $B2H = $self->bin2hex; + + # Comment: + $OUT->print("(This file must be converted with BinHex ", + ($self->requires || '4.0'), + ")\n"); + + # Build header in core: + my @hdrs; + my $flen = length($self->filename); + push @hdrs, pack("C", $flen); + push @hdrs, pack("a$flen", $self->filename); + push @hdrs, pack('C', $self->version); + push @hdrs, pack('a4', $self->type || '????'); + push @hdrs, pack('a4', $self->creator || '????'); + push @hdrs, pack('n', $self->flags || 0); + push @hdrs, pack('N', $self->data->length || 0); + push @hdrs, pack('N', $self->resource->length || 0); + my $hdr = join '', @hdrs; + + # Compute the header CRC: + my $crc = binhex_crc("\000\000", binhex_crc($hdr, 0)); + + # Output the header (plus its CRC): + $OUT->print($B2H->next($hdr . pack('n', $crc))); + + # Output the data fork: + $self->data->encode($OUT, $B2H); + + # Output the resource fork: + $self->resource->encode($OUT, $B2H); + + # Finish: + $OUT->print($B2H->done); + 1; +} + +=back + +=cut + + + +#============================== + +=head1 SUBMODULES + +=cut + +#============================================================ +# +package Convert::BinHex::Bin2Hex; +# +#============================================================ + +=head2 Convert::BinHex::Bin2Hex + +A BINary-to-HEX converter. This kind of conversion requires +a certain amount of state information; it cannot be done by +just calling a simple function repeatedly. Use it like this: + + # Create and use a "translator" object: + my $B2H = Convert::BinHex->bin2hex; # get a converter object + while () { + print STDOUT $B2H->next($_); # convert some more input + } + print STDOUT $B2H->done; # no more input: finish up + + # Re-use the object: + $B2H->rewind; # ready for more action! + while () { ... + +On each iteration, C (and C) may return either +a decent-sized non-empty string (indicating that more converted data +is ready for you) or an empty string (indicating that the converter +is waiting to amass more input in its private buffers before handing +you more stuff to output. + +Note that C I converts and hands you whatever is left. + +This may have been a good approach. It may not. Someday, the converter +may also allow you give it an object that responds to read(), or +a FileHandle, and it will do all the nasty buffer-filling on its own, +serving you stuff line by line: + + # Someday, maybe... + my $B2H = Convert::BinHex->bin2hex(\*STDIN); + while (defined($_ = $B2H->getline)) { + print STDOUT $_; + } + +Someday, maybe. Feel free to voice your opinions. + +=cut + +#------------------------------ +# +# new + +sub new { + my $self = bless {}, shift; + return $self->rewind; +} + +#------------------------------ +# +# rewind + +sub rewind { + my $self = shift; + $self->{CBIN} = ' ' x 2048; $self->{CBIN} = ''; # BIN waiting for xlation + $self->{HEX} = ' ' x 2048; $self->{HEX} = ''; # HEX waiting for output + $self->{LINE} = 0; # current line of output + $self->{EOL} = "\n"; + $self; +} + +#------------------------------ +# +# next MOREDATA + +sub next { shift->_next(0, @_) } + +#------------------------------ +# +# done + +sub done { shift->_next(1) } + +#------------------------------ +# +# _next ATEOF, [MOREDATA] +# +# Instance method, private. Supply more data, and get any more output. +# Returns the empty string often, if not enough output has accumulated. + +sub _next { + my $self = shift; + my $eof = shift; + + # Get the BINary data to process this time round, re-queueing the rest: + # Handle EOF and non-EOF conditions separately: + my $new_bin; + if ($eof) { # No more BINary input... + # Pad the queue with nuls to exactly 3n characters: + $self->{CBIN} .= ("\x00" x ((3 - length($self->{CBIN}) % 3) % 3)) + } + else { # More BINary input... + # "Compress" new stuff, and add it to the queue: + ($new_bin = $_[0]) =~ s/\x90/\x90\x00/g; + $self->{CBIN} .= $new_bin; + + # Return if not enough to bother with: + return '' if (length($self->{CBIN}) < 2048); + } + + # ...At this point, QUEUE holds compressed binary which we will attempt + # to convert to some HEX characters... + + # Trim QUEUE to exactly 3n characters, saving the excess: + my $requeue = ''; + $requeue .= chop($self->{CBIN}) while (length($self->{CBIN}) % 3); + + # Uuencode, adding stuff to hex: + my $hex = ' ' x 2048; $hex = ''; + pos($self->{CBIN}) = 0; + while ($self->{CBIN} =~ /(.{1,45})/gs) { + $hex .= substr(pack('u', $1), 1); + chop($hex); + } + $self->{CBIN} = reverse($requeue); # put the excess back on the queue + + # Switch to BinHex alphabet: + $hex =~ tr + {` -_} + {!!"#$%&'()*+,\x2D012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr}; + + # Prepend any HEX we have queued from the last time: + $hex = (($self->{LINE}++ ? '' : ':') . # start with ":" pad? + $self->{HEX} . # any output in the queue? + $hex); + + # Break off largest chunk of 64n characters, put remainder back in queue: + my $rem = length($hex) % 64; + $self->{HEX} = ($rem ? substr($hex, -$rem) : ''); + $hex = substr($hex, 0, (length($hex)-$rem)); + + # Put in an EOL every 64'th character: + $hex =~ s{(.{64})}{$1$self->{EOL}}sg; + + # No more input? Then tack on the remainder now: + if ($eof) { + $hex .= $self->{HEX} . ":" . ($self->{EOL} ? $self->{EOL} : ''); + } + + # Done! + $hex; +} + + + + +#============================================================ +# +package Convert::BinHex::Hex2Bin; +# +#============================================================ + +=head2 Convert::BinHex::Hex2Bin + +A HEX-to-BINary converter. This kind of conversion requires +a certain amount of state information; it cannot be done by +just calling a simple function repeatedly. Use it like this: + + # Create and use a "translator" object: + my $H2B = Convert::BinHex->hex2bin; # get a converter object + while () { + print STDOUT $H2B->next($_); # convert some more input + } + print STDOUT $H2B->done; # no more input: finish up + + # Re-use the object: + $H2B->rewind; # ready for more action! + while () { ... + +On each iteration, C (and C) may return either +a decent-sized non-empty string (indicating that more converted data +is ready for you) or an empty string (indicating that the converter +is waiting to amass more input in its private buffers before handing +you more stuff to output. + +Note that C I converts and hands you whatever is left. + +Note that this converter does I find the initial +"BinHex version" comment. You have to skip that yourself. It +only handles data between the opening and closing C<":">. + +=cut + +#------------------------------ +# +# new + +sub new { + my $self = bless {}, shift; + return $self->rewind; +} + +#------------------------------ +# +# rewind + +sub rewind { + my $self = shift; + $self->hex2comp_rewind; + $self->comp2bin_rewind; + $self; +} + +#------------------------------ +# +# next MOREDATA + +sub next { + my $self = shift; + $_[0] =~ s/\s//g if (defined($_[0])); # more input + return $self->comp2bin_next($self->hex2comp_next($_[0])); +} + +#------------------------------ +# +# done + +sub done { + return ""; +} + +#------------------------------ +# +# hex2comp_rewind + +sub hex2comp_rewind { + my $self = shift; + $self->{HEX} = ''; +} + +#------------------------------ +# +# hex2comp_next HEX +# +# WARNING: argument is modified destructively for efficiency!!!! + +sub hex2comp_next { + my $self = shift; + ### print "hex2comp: newhex = $newhex\n"; + + # Concat new with queue, and kill any padding: + my $hex = $self->{HEX} . (defined($_[0]) ? $_[0] : ''); + if (index($hex, ':') >= 0) { + $hex =~ s/^://; # start of input + if ($hex =~ s/:\s*\Z//) { # end of input + my $leftover = (length($hex) % 4); # need to pad! + $hex .= "\000" x (4 - $leftover) if $leftover; # zero pad + } + } + + # Get longest substring of length 4n possible; put rest back on queue: + my $rem = length($hex) % 4; + $self->{HEX} = ($rem ? substr($hex, -$rem) : ''); + for (; $rem; --$rem) { chop $hex }; + return undef if ($hex eq ''); # nothing to do! + + # Convert to uuencoded format: + $hex =~ tr + {!"#$%&'()*+,\x2D012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr} + { -_}; + + # Now, uudecode: + my $comp = ''; + my $len; + my $up; + local($^W) = 0; ### KLUDGE + while ($hex =~ /\G(.{1,60})/gs) { + $len = chr(32 + ((length($1)*3)>>2)); # compute length byte + $comp .= unpack("u", $len . $1 ); # uudecode + } + + # We now have the compressed binary... expand it: + ### print "hex2comp: comp = $comp\n"; + $comp; +} + +#------------------------------ +# +# comp2bin_rewind + +sub comp2bin_rewind { + my $self = shift; + $self->{COMP} = ''; + $self->{LASTC} = ''; +} + +#------------------------------ +# +# comp2bin_next COMP +# +# WARNING: argument is modified destructively for efficiency!!!! + +sub comp2bin_next { + my $self = shift; + + # Concat new with queue... anything to do? + my $comp = $self->{COMP} . (defined($_[0]) ? $_[0] : ''); + return undef if ($comp eq ''); + + # For each character in compressed string... + $self->{COMP} = ''; + my $lastc = $self->{LASTC}; # speed hack + my $exp = ''; # expanded string + my $i; + my ($c, $n); + for ($i = 0; $i < length($comp); $i++) { + if (($c = substr($comp, $i, 1)) eq "\x90") { # MARK + ### print "c = MARK\n"; + unless (length($n = substr($comp, ++$i, 1))) { + $self->{COMP} = "\x90"; + last; + } + ### print "n = ", ord($n), "; lastc = ", ord($lastc), "\n"; + $exp .= ((ord($n) ? ($lastc x (ord($n)-1)) # repeat last char + : ($lastc = "\x90"))); # literal MARK + } + else { # other CHAR + ### print "c = ", ord($c), "\n"; + $exp .= ($lastc = $c); + } + ### print "exp is now $exp\n"; + } + + # Either hit EOS, or there's a MARK char at the very end: + $self->{LASTC} = $lastc; + ### print "leaving with lastc=$lastc and comp=$self->{COMP}\n"; + ### print "comp2bin: exp = $exp\n"; + $exp; +} + + + + + + +#============================================================ +# +package Convert::BinHex::Fork; +# +#============================================================ + +=head2 Convert::BinHex::Fork + +A fork in a Macintosh file. + + # How to get them... + $data_fork = $HQX->data; # get the data fork + $rsrc_fork = $HQX->resource; # get the resource fork + + # Make a new fork: + $FORK = Convert::BinHex::Fork->new(Path => "/tmp/file.data"); + $FORK = Convert::BinHex::Fork->new(Data => $scalar); + $FORK = Convert::BinHex::Fork->new(Data => \@array_of_scalars); + + # Get/set the length of the data fork: + $len = $FORK->length; + $FORK->length(170); # this overrides the REAL value: be careful! + + # Get/set the path to the underlying data (if in a disk file): + $path = $FORK->path; + $FORK->path("/tmp/file.data"); + + # Get/set the in-core data itself, which may be a scalar or an arrayref: + $data = $FORK->data; + $FORK->data($scalar); + $FORK->data(\@array_of_scalars); + + # Get/set the CRC: + $crc = $FORK->crc; + $FORK->crc($crc); + +=cut + + +# Import some stuff into our namespace: +*binhex_crc = \&Convert::BinHex::binhex_crc; + +#------------------------------ +# +# new PARAMHASH + +sub new { + my ($class, %params) = @_; + bless \%params, $class; +} + +#------------------------------ +# +# length [VALUE] + +sub length { + my $self = shift; + + # Set length? + $self->{Length} = shift if @_; + + # Return explicit length, if any + return $self->{Length} if defined($self->{Length}); + + # Compute it: + if (defined($self->{Path})) { + return (-s $self->{Path}); + } + elsif (!ref($self->{Data})) { + return length($self->{Data}); + } + elsif (ref($self->{Data} eq 'ARRAY')) { + my $n = 0; + foreach (@{$self->{Data}}) { $n += length($_) } + return $n; + } + return undef; # unknown! +} + +#------------------------------ +# +# path [VALUE] + +sub path { + my $self = shift; + if (@_) { $self->{Path} = shift; delete $self->{Data} } + $self->{Path}; +} + +#------------------------------ +# +# data [VALUE] + +sub data { + my $self = shift; + if (@_) { $self->{Data} = shift; delete $self->{Path} } + $self->{Data}; +} + +#------------------------------ +# +# crc [VALUE] + +sub crc { + my $self = shift; + @_ ? $self->{CRC} = shift : $self->{CRC}; +} + +#------------------------------ +# +# encode OUT, B2H +# +# Instance method, private. Encode this fork as part of a BinHex stream. +# It will be printed to handle OUT using the binhexer B2H. + +sub encode { + my ($self, $OUT, $B2H) = @_; + my $buf = ''; + require POSIX if $^O||'' eq "MacOS"; + require Fcntl if $^O||'' eq "MacOS"; + my $fd; + + # Reset the CRC: + $self->{CRC} = 0; + + # Output the data, calculating the CRC as we go: + if (defined($self->{Path})) { # path to fork file + if ($^O||'' eq "MacOS" and $self->{Fork} eq "RSRC") { + $fd = POSIX::open($self->{Path},&POSIX::O_RDONLY | &Fcntl::O_RSRC); + while (POSIX::read($fd, $buf, 2048) > 0) { + $self->{CRC} = binhex_crc($buf, $self->{CRC}); + $OUT->print($B2H->next($buf)); + } + POSIX::close($fd); + } + else { + open FORK, $self->{Path} or die "$self->{Path}: $!"; + while (read(\*FORK, $buf, 2048)) { + $self->{CRC} = binhex_crc($buf, $self->{CRC}); + $OUT->print($B2H->next($buf)); + } + close FORK; + } + } + elsif (!defined($self->{Data})) { # nothing! + &Carp::carp("no data in fork!") unless $Convert::BinHex::QUIET; + } + elsif (!ref($self->{Data})) { # scalar + $self->{CRC} = binhex_crc($self->{Data}, $self->{CRC}); + $OUT->print($B2H->next($self->{Data})); + } + elsif (ref($self->{Data}) eq 'ARRAY') { # array of scalars + foreach $buf (@{$self->{Data}}) { + $self->{CRC} = binhex_crc($buf, $self->{CRC}); + $OUT->print($B2H->next($buf)); + } + } + else { + &Carp::croak("bad/unsupported data in fork"); + } + + # Finish the CRC, and output it: + $self->{CRC} = binhex_crc("\000\000", $self->{CRC}); + $OUT->print($B2H->next(pack("n", $self->{CRC}))); + 1; +} + + + + +#============================================================ +# +package Convert::BinHex::IO_Handle; +# +#============================================================ + +# Wrap a non-object filehandle inside a blessed, printable interface: +# Does nothing if the given $fh is already a blessed object. +sub wrap { + my ($class, $fh) = @_; + no strict 'refs'; + $fh or $fh = select; # no filehandle means selected one + ref($fh) or $fh = \*$fh; # scalar becomes a globref + return $fh if (ref($fh) and (ref($fh) !~ /^(GLOB|FileHandle)$/)); + bless \$fh, $class; # wrap it in a printable interface +} +sub print { + my $FH = ${shift(@_)}; + print $FH @_; +} +sub getline { + my $FH = ${shift(@_)}; + scalar(<$FH>); +} +sub read { + read ${$_[0]}, $_[1], $_[2]; +} + + + +#============================================================ +# +package Convert::BinHex::IO_Scalar; +# +#============================================================ + +# Wrap a scalar inside a blessed, printable interface: +sub wrap { + my ($class, $scalarref) = @_; + defined($scalarref) or $scalarref = \""; + pos($$scalarref) = 0; + bless $scalarref, $class; +} +sub print { + my $self = shift; + $$self .= join('', @_); + 1; +} +sub getline { + my $self = shift; + ($$self =~ /\G(.*?\n?)/g) or return undef; + return $1; +} +sub read { + my $self = shift; + $_[0] = substr($$self, pos($$self), $_[1]); + pos($$self) += $_[1]; + return length($_[0]); +} + + + +#============================== + +=head1 UNDER THE HOOD + +=head2 Design issues + +=over 4 + +=item BinHex needs a stateful parser + +Unlike its cousins I and I, BinHex format is not +amenable to being parsed line-by-line. There appears to be no +guarantee that lines contain 4n encoded characters... and even if there +is one, the BinHex compression algorithm interferes: even when you +can I one line at a time, you can't necessarily +I a line at a time. + +For example: a decoded line ending with the byte C<\x90> (the escape +or "mark" character) is ambiguous: depending on the next decoded byte, +it could mean a literal C<\x90> (if the next byte is a C<\x00>), or +it could mean n-1 more repetitions of the previous character (if +the next byte is some nonzero C). + +For this reason, a BinHex parser has to be somewhat stateful: you +cannot have code like this: + + #### NO! #### NO! #### NO! #### NO! #### NO! #### + while () { # read HEX + print hexbin($_); # convert and write BIN + } + +unless something is happening "behind the scenes" to keep track of +what was last done. I to work, if you only test it on BinHex files +which do not use compression and which have 4n HEX characters +on each line.> + +Since we have to be stateful anyway, we use the parser object to +keep our state. + + +=item We need to be handle large input files + +Solutions that demand reading everything into core don't cut +it in my book. The first MPEG file that comes along can louse +up your whole day. So, there are no size limitations in this +module: the data is read on-demand, and filehandles are always +an option. + + +=item Boy, is this slow! + +A lot of the byte-level manipulation that has to go on, particularly +the CRC computing (which involves intensive bit-shifting and masking) +slows this module down significantly. What is needed perhaps is an +I extension library where the slow pieces can be done more +quickly... a Convert::BinHex::CRC, if you will. Volunteers, anyone? + +Even considering that, however, it's slower than I'd like. I'm +sure many improvements can be made in the HEX-to-BIN end of things. +No doubt I'll attempt some as time goes on... + +=back + + + +=head2 How it works + +Since BinHex is a layered format, consisting of... + + A Macintosh file [the "BIN"]... + Encoded as a structured 8-bit bytestream, then... + Compressed to reduce duplicate bytes, then... + Encoded as 7-bit ASCII [the "HEX"] + +...there is a layered parsing algorithm to reverse the process. +Basically, it works in a similar fashion to stdio's fread(): + + 0. There is an internal buffer of decompressed (BIN) data, + initially empty. + 1. Application asks to read() n bytes of data from object + 2. If the buffer is not full enough to accomodate the request: + 2a. The read() method grabs the next available chunk of input + data (the HEX). + 2b. HEX data is converted and decompressed into as many BIN + bytes as possible. + 2c. BIN bytes are added to the read() buffer. + 2d. Go back to step 2a. until the buffer is full enough + or we hit end-of-input. + +The conversion-and-decompression algorithms need their own internal +buffers and state (since the next input chunk may not contain all the +data needed for a complete conversion/decompression operation). +These are maintained in the object, so parsing two different +input streams simultaneously is possible. + + +=head1 WARNINGS + +Only handles C files, as per RFC-1741. + +Remember that Macintosh text files use C<"\r"> as end-of-line: +this means that if you want a textual file to look normal on +a non-Mac system, you probably want to do this to the data: + + # Get the data, and output it according to normal conventions: + foreach ($HQX->read_data) { s/\r/\n/g; print } + + +=head1 CHANGE LOG + +Current version: $Id: BinHex.pm,v 1.119 1997/06/28 05:12:42 eryq Exp $ + +=over 4 + +=item Version 1.118 + +Ready to go public (with Paul's version, patched for native Mac support)! +Warnings have been suppressed in a few places where undefined values +appear. + +=item Version 1.115 + +Fixed another bug in comp2bin, related to the MARK falling on a +boundary between inputs. Added testing code. + +=item Version 1.114 + +Added BIN-to-HEX conversion. Eh. It's a start. +Also, a lot of documentation additions and cleanups. +Some methods were also renamed. + +=item Version 1.103 + +Fixed bug in decompression (wasn't saving last character). +Fixed "NoComment" bug. + +=item Version 1.102 + +Initial release. + +=back + + +=head1 AUTHOR AND CREDITS + +Written by Eryq, F / F + +Support for native-Mac conversion, I invaluable contributions in +Alpha Testing, I a few patches, I the baseline binhex/debinhex +programs, were provided by Paul J. Schinder (NASA/GSFC). + +Ken Lunde (Adobe) suggested incorporating the CAP file representation. + + +=head1 TERMS AND CONDITIONS + +Copyright (c) 1997 by Eryq. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms as +Perl itself. + +This software comes with B of any kind. +See the COPYING file in the distribution for details. + +=cut + +1; + +__END__ + +my $HQX = new Convert::BinHex + version => 0, + filename=>"s.gif", + type => "GIF8", + creator => "PCBH", + flags => 0xFFFF + ; + +$HQX->data(Path=>"/home/eryq/s.gif"); +$HQX->resource(Path=>"/etc/issue"); + +#$HQX->data(Data=>"123456789"); +#$HQX->resource(Data=>''); + +$HQX->encode(\*STDOUT); + +1; + + + + + + + + + diff --git a/t/Checker.pm b/t/Checker.pm new file mode 100644 index 0000000..9c80848 --- /dev/null +++ b/t/Checker.pm @@ -0,0 +1,33 @@ +package Checker; + +@ISA = qw(Exporter); +@EXPORT = qw($CHECK okay_if note check filter_warnings); + +$Checker::OUTPUT = 1; +$Checker::CHECK = 0; + +# Only lets through warnings that originate outside our toolkit: +sub filter_warnings { + $SIG{'__WARN__'} = sub { + print STDERR $_[0] if ($_[0] !~ /^MIME:/); + }; +} + +sub okay_if { + print( ($_[0] ? "ok\n" : "not ok\n")) +} + +sub note { + print STDOUT " ## ", @_, "\n" if $OUTPUT; +} + +sub check { + ++$CHECK; + my ($ok, $note) = @_; + $note = ($note ? ": $note" : ''); + my $stat = ($ok ? 'OK ' : 'ERR'); + printf STDOUT " Test %2d$note\n", $CHECK if $OUTPUT; + print(($ok ? "ok $CHECK\n" : "not ok $CHECK\n")); +} +1; + diff --git a/t/comp2bin.t b/t/comp2bin.t new file mode 100644 index 0000000..0583627 --- /dev/null +++ b/t/comp2bin.t @@ -0,0 +1,85 @@ +use lib "./blib/lib", "./lib", "./t"; + +use Checker; +use Convert::BinHex; + +%TEST = ( + PIVOT_3 => { + COMP => ["90 00 01 02 03 04 00", + "90 00 03"], + BIN => "90 01 02 03 04 00 90 03", + }, + PIVOT_2 => { + COMP => ["90 00 01 02 03 04 00 90", + "00 03"], + BIN => "90 01 02 03 04 00 90 03", + }, + PIVOT_1 => { + COMP => ["90 00 01 02 03 04 00 90 00", + "03"], + BIN => "90 01 02 03 04 00 90 03", + }, + CHOPPY => { + COMP => ["90", + "00", + "01 02 03 04", + "00", + "90", + "00", + "03"], + BIN => "90 01 02 03 04 00 90 03", + }, + FOUR_FIVES => { + COMP => ["01 02 03 04 05 90 04"], + BIN => "01 02 03 04 05 05 05 05", + }, + FOUR_FIVES_AND_A_SIX => { + COMP => ["01 02 03 04 05 90 04 06"], + BIN => "01 02 03 04 05 05 05 05 06", + }, + FOUR_MARKS => { + COMP => ["01 02 03 04 90 00 90 04"], + BIN => "01 02 03 04 90 90 90 90", + }, + FOUR_MARKS_AND_A_SIX => { + COMP => ["01 02 03 04 90 00 90 04 06"], + BIN => "01 02 03 04 90 90 90 90 06", + }, + FIVE_ONES_AND_TWOS => { + COMP => ["01 90 05 02 90 05"], + BIN => "01 01 01 01 01 02 02 02 02 02", + }, + ); + +sub str2hex { + my $str = shift; + eval '"\x' . join('\x', split(/\s+/,$str)) . '"'; +} + +#------------------------------------------------------------ +# BEGIN +#------------------------------------------------------------ +print "1..9\n"; +my $TESTKEY; +foreach $TESTKEY (sort keys %TEST) { + my $test = $TEST{$TESTKEY}; + my @comps = map { str2hex($_) } @{$test->{COMP}}; + my $bin = str2hex($test->{BIN}); + + my $comp; + my $rbin = ''; + my $H2B = Convert::BinHex->hex2bin; + foreach $comp (@comps) { + $rbin .= $H2B->comp2bin_next($comp); + } + check(($rbin eq $bin), "test $TESTKEY"); +} +1; + + + + + + + + diff --git a/test/hexbin b/test/hexbin new file mode 100644 index 0000000..26304fb --- /dev/null +++ b/test/hexbin @@ -0,0 +1,81 @@ +#!/usr/bin/perl +use lib "./lib"; +use Convert::BinHex; +use Getopt::Std; + +my $bytes; + +@ARGV or usage(); + + +# Get options: +getopts("vhn:o:"); +my $dir = $opt_o ||= "."; + +# Process files: +my $infile; +my $nfiles = int(@ARGV); +my $file_i = 0; +foreach $infile (@ARGV) { + ++$file_i; + + # Read header: + print STDERR "\nReading $infile\n"; + my $HQX = Convert::BinHex->open(Expr=>"<$infile") + || die "open $ARGV[0]: "; + + $HQX->read_header; + print STDERR $HQX->header_as_string if ($opt_v or $opt_h); + next if $opt_h; + + # Get output filename: + my $name; + if ($opt_n) { + $name = $opt_n . (($nfiles > 1) ? "-$file_i" : ''); + } + else { + ($name = $HQX->filename) =~ s/[^A-Za-z0-9_\.-]/_/g; + } + my $fname; + + # Output data fork: + $fname = "$dir/$name"; + print STDERR "Writing $fname (data fork)\n"; + printf STDERR "Expecting: %6d bytes\n", $HQX->data_length if $opt_v; + open DATA, ">$fname" or die "open $fname: $!"; + while ($bytes = $HQX->read_data) { + print DATA $bytes; + } + close DATA; + printf STDERR "Wrote: %6d bytes\n", (-s $fname) if $opt_v; + + # Output resource fork: + $fname = "$dir/$name.rsrc"; + print STDERR "Writing $fname (resource fork)\n"; + printf STDERR "Expecting: %6d bytes\n", $HQX->resource_length if $opt_v; + open RESOURCE, ">$fname" or die "open $fname: $!"; + while ($bytes = $HQX->read_resource) { + print RESOURCE $bytes; + } + close RESOURCE; + printf STDERR "Wrote: %6d bytes\n", (-s $fname) if $opt_v; + 1; +} +exit(0); + +sub usage { + print STDERR <#l}e>nt1%4I>2x@b69hq$ zBt=nXv)N*?&@^qeS{)9D)9G}%T*Je|j~_oCA0MBdo_0DMR+_e$&9uehuv$riph(h8 zQC7yJX{Xgno6VS7ZDDE=gqb9jC`vN*^?F>VvzpBgi$$;1(iCN3B;8uu29gC7@acLLk!{;B;7-45kYVWj=vQ380n%gdSsTom#F{$uOlvE(UO& z8bcwq98}2wy_OkPf+@u^F^Ec-PAnJ-s^!4HJHmAss#VJ|C9Fmv7y>X9pe;;&9j1g- za%Ktul`#{6m=csTS}1@i0jJa9aycy)GxHm*R*STuEyr`7q#i^J)1TA4)V_Fpm>Q2s*gL z)f`&kDOnm-)1IE&duUGO@3}h$?o@CC;sxh4&Blst!q(eGXK`m^nY2r%NQNBt%wEA?Pc>;3%fIn>qY9KK0ln? zn?2uro)$_aZB^Ox$yP zBC5T(J;Z|*{VL#LeWSMXL2y*7(ut zcE>BaA}#R;{oLy@isU+U|A~U>*kx&M?-4NtZhzf7W$GHc?>x|bWS);Ao;y#{(O(Aa?VmiJR5q!(_l4oxqe zoW*&6^=FohFD?k)`XuY*Oa~siyg2k)*x}4F1B-)5HZ^hthLqr1O|&w8XU3`Bhqn`d8~F;(O)4*s(JicjHtF+nWp!}@z6AGD`;{ge&GQ67IvAK1L2!HC%7 z7ZlfBcQa4-yMMFb)JtxSbP3@=x}Y;R_F-=#Gz#+%dxQW&i*$2yyl*B^`G~~G5ZH6?^3E`JTrZd5iPwK7QP4kFmp7nMO=3VY1Sm5sV zcG{fVf)?ls_Xpk#pUuk|=vh3w8I0R)JFLyqX8XTvj>2Pm-xZ98ZafXfw8oabft(6U zDyu5^C8lS4EO$#%mymS>=95*O@ZVImD|U!#{p*m;qB_A>pXPLwbk?)8x{#CzsOAUx zwh-G{cBB6qFV%o)9FaF-&iO%ti&o({mH#qMXn_>f&Rko9`c zvo=9j^?Y13OIR}D7AVN8x&D!2=^_)$E8u3G_r2^svYs8XjaVYq_CNpd!zR^v3BM5P z2~>~FxE~&A&zmo4gS?*Ac-ai3Se?ZGbl}qcqFe#BqwmnuliUjz`<4{iP`~yOw(r0} z1d`+_DrMzC-Lsmdn<}~RsiTRaQNQM*-mufAc$$UqcNT<%1L_#9g2ER6 zSd+p})m|PuyTfp9*Nc$*V=EHnlbuu@3lzfv<+SjL_`X;{ z5x^eHeWS+T27rd@lq$3(q4PU|Epc|wI$H2>;P5TF|*F0N(8;jgVERPn?X)F&IyYG#;g;sdECmSE5I_^*Ra& zZ_K^Q-&TG!ly2WQSJ%I5p`u@!!1BDPx(#-x&+~1-XWV sZ3g<-