Apple-2-Tools
/
DOS33-perl
mirror of https://github.com/softwarejanitor/DOS33.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Implemented lock & unlock for DOS 3.3

This commit is contained in:
Leeland Heins 2019-01-17 09:11:27 -06:00 committed by GitHub
parent 1b4ba33a04
commit 278326cd94
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 43 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
DOS33.pm
View File

@ -439,6 +439,8 @@ sub find_file {
my $cat_buf;
my @files = ();
do {
my $cur_cat_trk = $next_cat_trk;
my $cur_cat_sec = $next_cat_sec;
($cat_buf, $next_cat_trk, $next_cat_sec, @files) = get_cat_sec($dskfile, $next_cat_trk, $next_cat_sec);
if (defined $next_cat_trk && $next_cat_trk ne '') {
foreach my $file (@files) {
@ -446,7 +448,7 @@ sub find_file {
$fn =~ s/\s+$//g;
if ($fn eq $filename) {
#print "trk=$file->{'trk'} sec=$file->{'sec'}\n";
return $file, $next_cat_trk, $next_cat_sec, $cat_buf;
return $file, $cur_cat_trk, $cur_cat_sec, $cat_buf;
}
}
}
@ -508,11 +510,29 @@ sub unlock_file {
my ($file, $cat_trk, $cat_sec, $cat_buf) = find_file($dskfile, $filename);
if ($file->{'trk'}) {
##FIXME
print "cat_trk=$cat_trk cat_sec=$cat_sec\n" if $debug;
dump_sec($cat_buf) if $debug;
my @bytes = unpack "C*", $cat_buf;
# 12 is number of bytes before file descriptive entries, 35 is length of file descriptive entry.
my $file_type = $bytes[13 + (($file->{'cat_offset'} - 1) * 35)];
print sprintf("cat_offset=%d\n", $file->{'cat_offset'}) if $debug;
print sprintf("file_type=%02x\n", $file_type) if $debug;
# Mark file as unlocked.
my $new_file_type = $bytes[13 + (($file->{'cat_offset'} - 1) * 35)] & 0x7f;
print sprintf("new_file_type=%02x\n", $new_file_type) if $debug;
$bytes[13 + (($file->{'cat_offset'} - 1) * 35)] = $new_file_type;
# 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";
}
}
}
@ -526,11 +546,29 @@ sub lock_file {
my ($file, $cat_trk, $cat_sec, $cat_buf) = find_file($dskfile, $filename);
if ($file->{'trk'}) {
##FIXME
print "cat_trk=$cat_trk cat_sec=$cat_sec\n" if $debug;
dump_sec($cat_buf) if $debug;
my @bytes = unpack "C*", $cat_buf;
# 12 is number of bytes before file descriptive entries, 35 is length of file descriptive entry.
my $file_type = $bytes[13 + (($file->{'cat_offset'} - 1) * 35)];
print sprintf("cat_offset=%d\n", $file->{'cat_offset'}) if $debug;
print sprintf("file_type=%02x\n", $file_type) if $debug;
# Mark file as locked.
my $new_file_type = $bytes[13 + (($file->{'cat_offset'} - 1) * 35)] | 0x80;
print sprintf("new_file_type=%02x\n", $new_file_type) if $debug;
$bytes[13 + (($file->{'cat_offset'} - 1) * 35)] = $new_file_type;
# 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";
}
}
}

4
README
View File

@ -4,8 +4,8 @@ catalog.pl -- mostly working
freemap.pl -- mostly working
dos33read.pl -- mostly working for simple text files
dos33write.pl
dos33umlock.pl -- started
dos33lock.pl -- started
dos33umlock.pl -- mostly working
dos33lock.pl -- mostly working
dos33rename.pl -- started
dos33delete.pl -- started
dos33copy.pl