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