1#!/usr/bin/perl -w 2 3=encoding UTF-8 4 5=head1 NAME 6 7debinhex.pl - use Convert::BinHex to decode BinHex files 8 9 10=head1 USAGE 11 12Usage: 13 14 debinhex.pl [options] file ... file 15 16Where the options are: 17 18 -o dir Output in given directory (default outputs in file's directory) 19 -v Verbose output (normally just one line per file is shown) 20 21=head1 DESCRIPTION 22 23Each file is expected to be a BinHex file. By default, the output file is 24given the name that the BinHex file dictates, regardless of the name of 25the BinHex file. 26 27 28=head1 WARNINGS 29 30Largely untested. 31 32 33=head1 AUTHORS 34 35Paul J. Schinder (NASA/GSFC) mostly, though Eryq can't seem to keep 36his grubby paws off anything... 37 38Sören M. Andersen (somian), made it actually work under Perl 5.8.7 on MSWin32. 39 40=cut 41 42our $VERSION = '1.125'; # VERSION 43 44my $The_OS; 45BEGIN { $The_OS = $^O ? $^O : q// } 46eval { require Mac::Files } if ($The_OS eq "MacOS"); 47 48use Getopt::Std; 49use Convert::BinHex; 50use POSIX; 51use Fcntl; 52use File::Basename; 53use Carp; 54 55use strict; 56use vars qw( 57 $opt_o 58 $opt_v 59); 60 61my $DEBUG = 0; 62 63#------------------------------------------------------------ 64# main 65#------------------------------------------------------------ 66sub main { 67 68 # What usage? 69 @ARGV or usage(); 70 getopts('o:v'); 71 $DEBUG = $opt_v; 72 73 # Process files: 74 my $file; 75 foreach $file (@ARGV) { 76 debinhex($file); 77 } 78} 79exit(&main ? 0 : -1); 80 81#------------------------------------------------------------ 82# usage 83#------------------------------------------------------------ 84# Get usage from me. 85 86sub usage { 87 my $msg = shift || ''; 88 my $usage = ''; 89 if (open(USAGE, "<$0")) { 90 while (defined($_ = <USAGE>) and !/^=head1 USAGE/) {}; 91 while (defined($_ = <USAGE>) and !/^=head1/) {$usage .= $_}; 92 close USAGE; 93 } 94 else { 95 $usage = "Usage unavailable; please see the script itself."; 96 } 97 print STDERR "\n$msg$usage"; 98 exit -1; 99} 100 101#------------------------------------------------------------ 102# debinhex FILE 103#------------------------------------------------------------ 104# Decode the given FILE. 105# 106sub debinhex { 107 my $inpath = shift || croak("No filename given $!"); 108 local *BHEX; 109 my ($data, $testlength, $length, $fd); 110 111 print "DeBinHexing: $inpath\n"; 112 113 # Open BinHex file: 114 open(BHEX,"<$inpath") || croak("Unable to open $inpath: $!"); 115 binmode BHEX; 116 117 # Create converter interface on stream: 118 my $hqx = Convert::BinHex->open(FH => \*BHEX); 119 120 # Read header, and output as string if debugging: 121 $hqx->read_header; 122 print $hqx->header_as_string if $DEBUG; 123 124 # Get output directory/filename: 125 my ($inname, $indir) = fileparse($inpath); 126 my $outname = $hqx->filename || 'NONAME'; 127 my $outdir = $opt_o || $indir; 128 my $outpath = "$outdir/$outname"; $outpath =~ s{/+}{/}g; 129 130 # Create Mac file: 131 if ($The_OS eq "MacOS") { 132 Mac::Files::FSpCreate($outpath, $hqx->creator, $hqx->type) 133 or croak("Unable to create Mac file $outpath"); 134 } 135 136 # Get lengths of forks: 137 my $dlength = $hqx->data_length; 138 my $rlength = $hqx->resource_length; 139 140 # Write data fork: 141 print "Writing: $outpath\n"; 142 $fd = POSIX::open($outpath, (&POSIX::O_WRONLY | &POSIX::O_CREAT | &Fcntl::O_BINARY), 0755); 143 $testlength = 0; 144 while (defined($data = $hqx->read_data)) { 145 $length = length($data); 146 POSIX::write($fd, $data, $length) 147 or croak("couldn't write $length bytes: $!"); 148 $testlength += $length; 149 } 150 POSIX::close($fd) or croak "Unable to close $outpath"; 151 croak("Data fork length mismatch: ". 152 "expected $dlength, wrote $testlength") 153 if $dlength != $testlength; 154 155 # Write resource fork? 156 if ($rlength) { 157 158 # Determine how to open fork file appropriately: 159 my ($rpath, $rflags); 160 if ($The_OS eq "MacOS") { 161 $rpath = $outpath; 162 $rflags = (&POSIX::O_WRONLY | &POSIX::O_CREAT | &Fcntl::O_RSRC); 163 } 164 else { 165 $rpath = "$outpath.rsrc"; 166 $rflags = (&POSIX::O_WRONLY | &POSIX::O_CREAT | &Fcntl::O_BINARY); 167 } 168 169 # Write resource fork... 170 $fd = POSIX::open($rpath, $rflags, 0755); 171 $testlength = 0; 172 while (defined($data = $hqx->read_resource)) { 173 $length = length($data); 174 POSIX::write($fd,$data,$length) 175 or croak "Couldn't write $length bytes: $!"; 176 $testlength += $length; 177 } 178 POSIX::close($fd) or croak "Unable to close $rpath"; 179 croak("Resource fork length mismatch: ". 180 "expected $rlength, wrote $testlength") 181 if $testlength != $rlength; 182 } 183 184 # Set Mac attributes: 185 if ($The_OS eq "MacOS") { 186 my $has = Mac::Files::FSpGetCatInfo($outpath); 187 my $finfo = $has->{ioFlFndrInfo}; 188 $finfo->{fdFlags} = $hqx->flags & 0xfeff; #turn off inited bit 189 $finfo->{fdType} = $hqx->type || "????"; 190 $finfo->{fdCreator} = $hqx->creator || "????"; 191 192 # Turn on the bundle bit if it's an application: 193### $finfo->{fdFlags} |= 0x2000 if $finfo->{fdType} eq "APPL"; 194 195 if ($DEBUG) { 196 printf("%x\n",$finfo->{fdFlags}); 197 printf("%s\n",$finfo->{fdType}); 198 printf("%s\n",$finfo->{fdCreator}); 199 } 200 $has->{ioFlFndrInfo} = $finfo; 201 Mac::Files::FSpSetCatInfo($outpath, $has) 202 or croak "Unable to set catalog info $^E"; 203 if ($DEBUG) { 204 $has = Mac::Files::FSpGetCatInfo ($outpath); 205 printf("%x\n",$has->{ioFlFndrInfo}->{fdFlags}); 206 printf("%s\n",$has->{ioFlFndrInfo}->{fdType}); 207 printf("%s\n",$has->{ioFlFndrInfo}->{fdCreator}); 208 } 209 } 210 1; 211} 212 213#------------------------------------------------------------ 214__END__ 215# Last modified: 16 Feb 2006 at 05:16 PM EST 216