mirror of
https://github.com/softwarejanitor/DOS33.git
synced 2024-12-26 16:29:17 +00:00
Bug fixes
This commit is contained in:
Leeland Heins
GitHub
parent
bef755b0a1
commit
f160047359
77
DOS33.pm
77
DOS33.pm
@ -495,6 +495,7 @@ sub read_file {
|
||||
#print sprintf("%c", $byte & 0x7f);
|
||||
print sprintf("%c", $byte);
|
||||
}
|
||||
##FIXME -- need to handle additional file types + handle incomplete last sectors properly here.
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -582,13 +583,85 @@ sub delete_file {
|
||||
|
||||
my ($file, $cat_trk, $cat_sec, $cat_buf) = find_file($dskfile, $filename);
|
||||
if (defined $file && $file && $file->{'trk'}) {
|
||||
##FIXME
|
||||
print "cat_trk=$cat_trk cat_sec=$cat_sec\n";
|
||||
dump_sec($cat_buf) if $debug;
|
||||
my @bytes = unpack "C*", $cat_buf;
|
||||
|
||||
# Mark file as deleted.
|
||||
# 11 is first tslist sector track
|
||||
my $first_tslist_sec_trk = $bytes[11 + (($file->{'cat_offset'} - 1) * 35)];
|
||||
print sprintf("first_tslist_sec_trk=%02x\n", $first_tslist_sec_trk);
|
||||
$bytes[11 + (($file->{'cat_offset'} - 1) * 35)] = 0x00;
|
||||
# Set last byte of filename to first tslist sector track
|
||||
$bytes[43 + (($file->{'cat_offset'} - 1) * 35)] = $first_tslist_sec_trk;
|
||||
|
||||
# Re-pack the data in the sector.
|
||||
$cat_buf = pack "C*", @bytes;
|
||||
|
||||
dump_sec($cat_buf) if $debug;
|
||||
# Write back catalog sector.
|
||||
#if (!wts($dskfile, $cat_trk, $cat_sec, $cat_buf)) {
|
||||
# print "Failed to write catalog sector $cat_trk $cat_sec!\n";
|
||||
#}
|
||||
|
||||
my ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec, $rel_num_dos, $dsk_vol_num, $max_tslist_secs, $last_trk_secs_alloc, $dir_trk_alloc, $num_trks_dsk, $num_secs_dsk, $num_bytes_sec, $bit_map_free_secs) = get_vtoc_sec($dskfile);
|
||||
|
||||
my $tmpl = '';
|
||||
for (my $t = $min_trk; $t <= $max_trk; $t++) {
|
||||
$tmpl .= $bit_map_free_sec_tmpl;
|
||||
}
|
||||
|
||||
print "tmpl=$tmpl\n" if $debug;
|
||||
my @flds = unpack $tmpl, $bit_map_free_secs;
|
||||
|
||||
if ($debug) {
|
||||
for (my $t = $min_trk; $t <= $max_trk; $t++) {
|
||||
print sprintf("%2d %04x\n", $t, $flds[$t]) if $debug;
|
||||
print sprintf("%2d %016b\n", $t, $flds[$t]) if $debug;
|
||||
my $fr = sprintf("%016b", $flds[$t]);
|
||||
print "fr=$fr\n" if $debug;
|
||||
my $fm = reverse $fr;
|
||||
print "fm=$fm\n" if $debug;
|
||||
$fm =~ s/0/ /g;
|
||||
$fm =~ s/1/*/g;
|
||||
print "fm=$fm\n" if $debug;
|
||||
print sprintf("%2d|%s\n", $t, $fm);
|
||||
}
|
||||
}
|
||||
|
||||
# get the files t/s list and free those sectors
|
||||
my @secs = get_tslist($dskfile, $file->{'trk'}, $file->{'sec'});
|
||||
foreach my $sec (@secs) {
|
||||
next if $sec->{'trk'} == 0 && $sec->{'sec'} == 0;
|
||||
#print "trl=$sec->{'trk'} sec=$sec->{'sec'}\n";
|
||||
my $fr = sprintf("%016b", $flds[$sec->{'trk'}]);
|
||||
#print "fr=$fr\n";
|
||||
$flds[$sec->{'trk'}] |= (1 << $sec->{'sec'});
|
||||
my $fr2 = sprintf("%016b", $flds[$sec->{'trk'}]);
|
||||
#print "fr=$fr2\n";
|
||||
}
|
||||
##FIXME -- may need to free additional tslist sectors.
|
||||
$flds[$file->{'trk'}] |= (1 << $file->{'sec'});
|
||||
|
||||
if ($debug) {
|
||||
for (my $t = $min_trk; $t <= $max_trk; $t++) {
|
||||
print sprintf("%2d %04x\n", $t, $flds[$t]) if $debug;
|
||||
print sprintf("%2d %016b\n", $t, $flds[$t]) if $debug;
|
||||
my $fr = sprintf("%016b", $flds[$t]);
|
||||
print "fr=$fr\n" if $debug;
|
||||
my $fm = reverse $fr;
|
||||
print "fm=$fm\n" if $debug;
|
||||
$fm =~ s/0/ /g;
|
||||
$fm =~ s/1/*/g;
|
||||
print "fm=$fm\n" if $debug;
|
||||
print sprintf("%2d|%s\n", $t, $fm);
|
||||
}
|
||||
}
|
||||
|
||||
$bit_map_free_secs = pack $tmpl, @flds;
|
||||
|
||||
# Write vtoc back
|
||||
##FIXME
|
||||
}
|
||||
}
|
||||
|
||||
@ -628,7 +701,6 @@ sub rename_file {
|
||||
# Re-pack the data in the sector.
|
||||
$cat_buf = pack "C*", @bytes;
|
||||
|
||||
# Write back catalog sector.
|
||||
dump_sec($cat_buf) if $debug;
|
||||
# Write back catalog sector.
|
||||
if (!wts($dskfile, $cat_trk, $cat_sec, $cat_buf)) {
|
||||
@ -663,6 +735,5 @@ sub write_file {
|
||||
##FIXME
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
2
README
2
README
@ -7,7 +7,7 @@ dos33write.pl -- started
|
||||
dos33umlock.pl -- mostly working
|
||||
dos33lock.pl -- mostly working
|
||||
dos33rename.pl -- mostly working
|
||||
dos33delete.pl -- started
|
||||
dos33delete.pl -- in progress
|
||||
dos33copy.pl -- started
|
||||
zap.pl -- partially working
|
||||
prozap.pl -- partially working
|
||||
|
||||
@ -18,6 +18,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -19,6 +19,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -19,6 +19,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -19,6 +19,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -52,6 +52,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
} elsif ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -19,6 +19,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -19,6 +19,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -52,6 +52,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
} elsif ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -18,6 +18,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -24,6 +24,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
$blk = $ARGV[1];
|
||||
shift;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -18,6 +18,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -52,6 +52,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
} elsif ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -48,6 +48,8 @@ while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
} elsif ($ARGV[0] eq "-w") {
|
||||
$write = 1;
|
||||
shift;
|
||||
} else {
|
||||
die "Unknown command line argument $ARGV[0]\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user