use Digest::SHA1 qw(sha1_base64);
# uncdsk.pl format image...
# extract cpm files from a disk image with the given format
# maps illegal chars /  => %, \ => %, : => ;, < => [,  > => ], | => !
# maps reserved Windows names by prepending _
# if a file name clashes with that from a lower numbered user area then
# usernum_ is prepended


$cnt = 0 ;
$format = shift @ARGV;
local @nostar;      # records whether we can't use n:* to extract files
local @used;        # records whether a user area is used


sub checksum
{
    local $/;           # slurp files
	open my $in, "<:raw", $_[0] or return "**Can't checksum";
	$checksum = sha1_base64(<$in>);
    close $in;
	return $checksum;
}

%reserved = (aux => 1, prn => 1, nul => 1, con => 1,
             com1 => 1, com2 => 1, com3 => 1, com4 => 1, com5 => 1,
             com6 => 1, com7 => 1, com8 => 1, com9 => 1,
             lpt1 => 1, lpt2 => 1, lpt3 => 1, lpt4 => 1, lpt5 => 1,
             lpt6 => 1, lpt7 => 1, lpt8 => 1, lpt9 => 1);

sub isreserved
{
    $_[0] =~ /^([^\.]*)/;
    return defined($reserved{$1});
}

while ($file = shift @ARGV) {
    $cnt++;
    open ($in, "cpmls -f \"$format\" -i \"$file\" |") or die "can't do cpmls on $file\n";
    while (<$in>) {
        if (/^(\d+):/) {
            $user = $1;
        } elsif (/^\s+(\d+)\s(\S+)/) {
            my ($ino, $name, $dosname) = ($1, $2, $2);
            push @{$used[$user]}, $name;
            $inode[$ino] = "$user:$name";
            $imap{"$user:$name"} = $ino;
            $dosname =~ tr/\\\/:<>|/%%;[]!/;        # change illegal characters
            $dosname = "$user_$dosname" if ($dup{$name}++ != 0);
            $dosname = "_$dosname" if (isreserved($dosname));
            $nmap{"$user:$name"} = $dosname;
            $nostar[$user]++ if ($dosname ne $name);
        }
    }
    close $in;
    $file =~ /^(.*)\./;
    my $dir = $1;
    mkdir $dir if ! -d $dir;
    for ($u = 0; $u <= $#used; $u++) {
        next unless $used[$u];
        if ($nostar[$u]) {
            foreach $f (@{$used[$u]}) {
                my $target = $nmap{"$u:$f"};
                system("cpmcp -f \"$format\" \"$file\" \"$u:$f\" \"$dir/$target\"");
            }
        } else {
            system("cpmcp -f \"$format\" \"$file\" \"$u:*\" \"$dir\"");
        }
    }

    open ($in, "cpmls -f \"$format\" -F \"$file\" |") or die "can't do cpmls on $file\n";
    while (<$in>) {
        if (/:  User\s+(\d+)/) {
            $user = $1;
        } elsif (/^$/ || /^ / || /^------------/) {
            next;
        } elsif (/^Total/) {
            $summary .= "# " . $_;
        } else {
            chomp;
            my($fname, $ext, $bytes, $recs, $attr, $prot, $update, $create) = unpack(
                "A9 A4 A7 A7 A13 A7 A15 A14", $_);
            $fname = lc($fname);
            $fname .= "." . lc($ext) if ($ext ne "");
            $recs =~ tr/ //d;
            $attr =~ tr/ //d;
            $prot =~ tr/ //d;
            $info{"$user:$fname"} = $attr;
        }
    }
    close $in;

    $label = $file;
    $label =~ s/\.[^\.]*$//;
    open ($out, ">", "$dir/\@$label") or die "can't create $dir/\@$label\n";
    print $out "Disk:\t$file\n"; 
    print $out "Format:\t$format\n";

    print $out $summary;
    print $out "Files:\n";
    foreach my $f (@inode) {
        next if $f eq "";
        my ($u, $fn) = split ":", $f;
        if ($u != 0) {
            printf $out "%d:", $u;
        }
        my $hash = checksum("$dir/$nmap{$f}"); 
        print $out "$fn|$info{$f}|$hash|$nmap{$f}\n";
    }
    close $out;
}

            
print "usage: uncdsk.pl format file...\n" if $cnt == 0;