#!/usr/bin/perl

# respack 0.1 - packing a directory tree created with resutil 
#		into a resource fork
#  by Yusuke Shinyama, 2001/7	* this software is public domain *

# padding
$RESOURCE_DATA_START = 0x100;

sub usage { print "usage: $0 unpackeddir\n"; exit 1; }

sub err { print STDERR "$0: $_[0]\n"; }

$POS=0;
sub wuint8 { $POS+=1; syswrite(STDOUT, pack('C', $_[0]), 1); }
sub wuint16 { $POS+=2; syswrite(STDOUT, pack('n', $_[0]), 2); }
sub wuint24 { $POS+=3; syswrite(STDOUT, substr(pack('N', $_[0]),1), 3); }
sub wuint32 { $POS+=4; syswrite(STDOUT, pack('N', $_[0]), 4); }
sub wstr32 { $POS+=4; syswrite(STDOUT, $_[0], 4); }
sub wstrn { $POS+=length($_[0]); syswrite(STDOUT, $_[0], length($_[0])); }
sub wgoto { die("illegal seek: $_[0]") if ($_[0] < $POS);
	    syswrite(STDOUT, "\000" x ($_[0]-$POS), $_[0]-$POS); $POS=$_[0]; }

$dir = $ARGV[0] || &usage();
chdir($dir) || die("chdir: $!\n");

open(IN, "rsrc_attr") || die("open: $!\n");
<IN> || die("cannot read resource attr: $!\n");
chop; $resource_attr = unpack("n", pack("B16", $_));
close(IN);

$offset_data = 0;
$map_offset_restype = 0;
$map_offset_reflist = 0;
$map_offset_resname = 0;
opendir(TYPES, ".") || die("opendir: $!");
foreach my $t (sort {$b cmp $a} (readdir(TYPES))) {
    next if ($t eq '.' || $t eq '..' || $t eq 'rsrc_attr');
    if ($t !~ /^....$/) { &err("unknown type: $t"); next; }
    push(@restype_names, $t);
    $restype_offsets_restype{$t} = $map_offset_restype;
    $restype_offsets_reflist{$t} = $map_offset_reflist;
    $map_offset_restype += (4+2+2);
    if (!opendir(IDS, $t)) { &err("opendir: $t: $!"); next; }
    my @ids = sort(readdir(IDS));
    foreach my $f (@ids) {
	next if ($f eq '.' || $f eq '..');
	if ($f =~ /^(\d+)\.data$/) {
	    my $id = $1;
	    if (!open(IN, "$t/$id.info")) {
		&err("open: $t/$id.info: $!"); next; 
	    }
	    my $attr = 0, $name = '';
	    while(<IN>) {
		chop; split("\t");
		if ($_[0] eq 'attr') { $attr = ord(pack("B8", $_[1])); }
		elsif ($_[0] eq 'name') { $name = $_[1]; }
		else { &err("unknown field: $t/$id: $_[0]"); }
	    }
	    close(IN);
	    if (!(@_ = stat("$t/$id.data"))) { 
		&err("stat: $t/$id.data: $1"); next; 
	    }
	    my $size = $_[7];
	    push(@{$res_ids{$t}}, $id);
	    push(@{$res_attrs{$t}}, $attr);
	    push(@{$res_sizes{$t}}, $size);
	    push(@{$res_offsets{$t}}, $offset_data);
	    if ($name) {
		push(@{$res_nameoffsets{$t}}, $map_offset_resname);
		push(@res_names, $name);
		$map_offset_resname += (1+length($name));
	    } else {
		push(@{$res_nameoffsets{$t}}, 0xffff);
	    }
	    $offset_data += 4 + $size;
	    $map_offset_reflist += (2+2+1+3+4);
	}
    }
    closedir(IDS);
}
closedir(TYPES);
$map_offset_restype += 2;

# resource header
sub header {
    &wuint32($RESOURCE_DATA_START);
    &wuint32($RESOURCE_DATA_START + $offset_data);
    &wuint32($offset_data);
    &wuint32(16+4+2+2+2+2 + $map_offset_restype + $map_offset_reflist + $map_offset_resname);
}
&header();

# paddings
&wgoto($RESOURCE_DATA_START);

# resource data
$BUFSIZ = 1024;
sub cat1 {
    open(IN, $_[0]) || die("open: $_[0]: $!");
    binmode(IN);
    while(my $len = sysread(IN, $_, $BUFSIZ)) { syswrite(STDOUT, $_, $len); }
    close(IN);
}
foreach my $t (@restype_names) {
    my $r_ids = $res_ids{$t};
    my $r_sizes = $res_sizes{$t};
    for(my $i = 0; $i < @{$r_ids}; $i++) {
	&wuint32($r_sizes->[$i]);
	&cat1("$t/" . $r_ids->[$i] . ".data"); 
    }
}

# resource map
&header();			# header again
&wuint32(0);			# reserved
&wuint16(0);			# reserved

&wuint16($resource_attr);		# resource fork attributes
&wuint16(16+4+2+2+2+2);		# offset from beginning of map to restype list
&wuint16(16+4+2+2+2+2 + $map_offset_restype + $map_offset_reflist);
				# offset from beginning of map to restype list

# restype list
&wuint16(-1+@restype_names);
$i = 0;
foreach my $t (@restype_names) {
    &wstr32($t);
    &wuint16(-1+@{$res_ids{$t}});
    &wuint16($map_offset_restype + $restype_offsets_reflist{$t});
}

# reflist
foreach my $t (@restype_names) {
    my $r_ids = $res_ids{$t};
    my $r_attrs = $res_attrs{$t};
    my $r_nameoffsets = $res_nameoffsets{$t};
    my $r_offsets = $res_offsets{$t};
    for(my $i = 0; $i < @{$r_ids}; $i++) {
	&wuint16($r_ids->[$i]);
	&wuint16($r_nameoffsets->[$i]);
	&wuint8($r_attrs->[$i]);
	&wuint24($r_offsets->[$i]);
	&wuint32(0);
    }
}

# resnames
foreach my $n (@res_names) {
    &wuint8(length($n));
    &wstrn($n);
}
