#!/usr/bin/perl -w

# Note: when/if I ever manage to reimplement the ALF decompressor in
# C, this script will serve as the prototype for the unalf tool, which
# will of course be in C also...

use bytes;

sub chrat {
	my $offs = shift;
	return substr($data, $offs, 1);
}

sub wordat {
	my $offs = shift;
	return ord(chrat($offs)) | (ord(chrat($offs + 1)) << 8);
}

sub longat {
	my $offs = shift;
	return wordat($offs) | (wordat($offs + 2) << 16);
}

sub header_ok {
	my $pos = shift || 0;

	return 0 unless chrat($pos) eq chr(0x1a);

	my $c = ord(chrat($pos + 1 ));

	if($c >= 2 && $c <= 9) {
		warn "$SELF: this is an ARC archive (not ALF).\n" unless $arc_warn;
		$arc_warn++;
		return 1;
	} elsif($c == 0x0f) {
		return 1;
	}

	return 0;
}

@monthnames = qw/??? Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ??? ??? ???/;

# see Arcinfo...
sub extract_date {
	my $pos = shift;
	my $date = wordat($pos);

	my $year = ($date >> 9) + 1980;
	$year %= 100; # only ever print last 2 digits

	my $month = ($date >> 5) & 0x0f;
	$month = $monthnames[$month];

	my $day = $date & 0x1f;

	my $res = sprintf("%2d %3s %2d", $day, $month, $year);
	return $res;
}

sub extract_time {
	my $pos = shift;
	my $time = wordat($pos);

	my $hour = $time >> 11;
	my $min = ($time >> 5) & 0x3f;
	# don't bother with sec, we don't display them.

	# special case: "arc v" displays 00:00 as 12:00p.
	if($hour == 0 && $min == 0) {
		$hour = 24;
	}

	my $ampm = ($hour > 11 ? 'p' : 'a');
	$hour %= 12;
	$hour = 12 if $hour == 0;

	my $res = sprintf("%2d:%02d%s", $hour, $min, $ampm);
	return $res;
}

sub list_file {
	# each file header is 29 bytes.

	# bytes 0-1 are 0x1a (ARCMARK) and 0x0f (ALF compression type)

	# bytes 2-14 are filename, though the Atari max filename len
	#   is 12 (e.g. FOOBARXX.EXT).

	# bytes 15-18 are 4-byte compressed length (LSB first).
	#   bytes 17-18 should always be 0, I don't think alfcrunch
	#   can handle a file >64K. even if it can, byte 18 should still
	#   always be 0, because *surely* it can't handle a file that's
	#   >16M. for that matter, most Atari DOSes can't handle a hard
	#   drive partition >16M...

	# bytes 19-22 are date/time stamp, hopefully the same as ARC.

	# bytes 23-24 are the checksum CRC-16 (?) checksum.

	# bytes 25-28 are the 4-byte uncompressed length (LSB first).
	#   bytes 27-28 should always be 0 (as above).

	# the 29-byte header is followed by the compressed data, whose length
	# matches the compressed length in bytes 15-18.

	# a lot of the files in the the Holmes archive have filler bytes at
	# the end, put there by ancient dumb file transfer protocols, or
	# dumb DOSes (doesn't CP/M do this?).

	if(!header_ok($pos)) {
		warn "$SELF: Junk at EOF (probably harmless).\n";
		$pos += (1 << 31); # ludicrous size, makes main loop exit.
		return;
	}

	# read the filename until we hit a null byte, or a space, or
	# the max length. all the .alf files I have, do have a null byte
	# terminator for the filename... followed by spaces to fill up the
	# rest of the 13-byte field.
	my $filename = "";
	for(my $i = 2; $i < 15; $i++) {
		my $b = chrat($pos + $i);
		last if ord($b) == 0 || $b eq ' ';
		$filename .= $b;
	}

	my $clen = longat($pos + 15);
	my $ulen = longat($pos + 25);
	my $crc = wordat($pos + 23);
	my $date = extract_date($pos + 19);
	my $time = extract_time($pos + 21);
	my $pct = 100 - int($clen / $ulen * 100);

	printf("%-12s  ", $filename);
	printf("%8d  ", $ulen);
	if(chrat($pos + 1) eq chr(0x0f)) {
		print("     ALF  ");
	} else {
		print("     ARC  ");
	}
	printf("%3d%%  ", $pct);
	printf("%8d  ", $clen);
	printf("%9s  ", $date);
	printf("%6s  ", $time);
	printf("%04x\n", $crc);

	if($ENV{DUMP}) {
		my $bits;
		for(my $i = 0; $i < $clen; $i++) {
			$bits .= sprintf("%08b", ord(chrat($pos + 29 + $i)));
		}
		my $count = 0;
		while($bits =~ s/^([01]{9})//) {
			my $ctlbit = substr($1, 0, 1);
			my $byte = substr($1, 1);
			my $val = eval "0b$byte";
			my $hex = sprintf('$%02x', $val);
			printf("%3d: ", $count++);
			print "$ctlbit $byte ; ";
			if($ctlbit eq '0') {
				print "literal $hex";
				if($val > 32 && $val < 127) {
					print " " . chr($val);
				}
			} else {
				my $name = "(?)";
				if($val == 0) {
					$name = "start";
				} elsif($val == 1) {
					$name = "end";
				}
				print "$val $name";
			}
			print "\n";
		}
		print "junk: $bits\n" if length($bits);
	}

	$total_clen += $clen;
	$total_ulen += $ulen;
	$file_count++;

	$pos += ($clen + 29);
}

# main()

$total_clen = $total_ulen = $file_count = 0;

($SELF = $0) =~ s,.*/,,;

if(@ARGV != 1) {
	die "$SELF requires exactly one ALF file as an argument.\n";
} elsif($ARGV[0] =~ /--?h(elp)?/) {
	print <<EOF;
$SELF - list contents of an ALF (or ARC) archive file.

Usage: $SELF <archive>

For each file in the ALF or ARC archive, displays the filename,
compressed and uncompressed sizes, compression amount, date/time,
and CRC. After all files are listed, the total sizes and compression
are shown.

The output is intended to look like that of "arc v", except the
Stowage column only ever says "ALF" or "ARC" (doesn't show e.g.
"Squashed", "Crunched", etc for ARC files).

Exit status is 0 on success, non-zero on failure.
EOF
	exit 0;
}

undef $/;

$data = <>;

#warn "read " . length($data) . " bytes\n";
die("$SELF: Not an alfcrunch file.\n") unless header_ok();

print <<EOF;
Name          Length    Stowage    SF   Size now  Date       Time    CRC
============  ========  ========  ====  ========  =========  ======  ====
EOF

$pos = 0;
while($pos < length($data)) {
	list_file();
}

print "        ====  ========            ====  ========\nTotal   ";
printf("%4d  ", $file_count);
printf("%8d", $total_ulen);
print ' ' x 12;
printf("%3d%%  ", 99);
printf("%8d\n", $total_clen);


exit 0;