mirror of
https://github.com/softwarejanitor/DOS33.git
synced 2024-12-21 15:29:26 +00:00
Partial implementation of procat.pl
This commit is contained in:
Leeland Heins
GitHub
parent
ddd5f1fde8
commit
904c9ef749
287
ProDOS.pm
287
ProDOS.pm
@ -10,10 +10,66 @@ use Exporter::Auto;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
# ProDOS file types
|
||||
my %ftype = (
|
||||
# 00 Typeless file
|
||||
0x00 => ' ',
|
||||
# 01 BAD Bad block(s) file
|
||||
0x01 => 'BAD',
|
||||
# 04 TXT Text file (ASCII text, msb off)
|
||||
0x04 => 'TXT',
|
||||
# 06 BIN Binary file (8-bit binary image)
|
||||
0x06 => 'BIN',
|
||||
# 0f DIR Directory file
|
||||
0x0f => 'DIR',
|
||||
# 19 ADB AppleWorks data base file
|
||||
0x19 => 'ADB',
|
||||
# 1a AWP AppleWorks word processing file
|
||||
0x1a => 'AWP',
|
||||
# 1b ASP AppleWorks spreadsheet file
|
||||
0x1b => 'ASP',
|
||||
# ef PAS ProDOS PASCAL file
|
||||
0xef => 'PAS',
|
||||
# f0 CMD ProDOS added command file
|
||||
0xf0 => 'CMD',
|
||||
# f1-f8 User defined file types 1 through 8
|
||||
0xf1 => 'UD1',
|
||||
0xf2 => 'UD2',
|
||||
0xf3 => 'UD3',
|
||||
0xf4 => 'UD4',
|
||||
0xf5 => 'UD5',
|
||||
0xf6 => 'UD6',
|
||||
0xf7 => 'UD7',
|
||||
0xf8 => 'UD8',
|
||||
# fc BAS Applesoft BASIC program file
|
||||
0xfc => 'BAS',
|
||||
# fd VAR Applesoft stored variables file
|
||||
0xfd => 'VAR',
|
||||
# fe REL Relocatable object module file (EDASM)
|
||||
0xfe => 'REL',
|
||||
# ff SYS ProDOS system file
|
||||
0xff => 'SYS',
|
||||
);
|
||||
|
||||
my %months = (
|
||||
1, 'JAN',
|
||||
2, 'FEB',
|
||||
3, 'MAR',
|
||||
4, 'APR',
|
||||
5, 'MAY',
|
||||
6, 'JUN',
|
||||
7, 'JUL',
|
||||
8, 'AUG',
|
||||
9, 'SEP',
|
||||
10, 'OCT',
|
||||
11, 'NOV',
|
||||
12, 'DEC',
|
||||
);
|
||||
|
||||
my $key_vol_dir_blk = 2;
|
||||
|
||||
#
|
||||
# Volume Directory Block
|
||||
# Key Volume Directory Block
|
||||
#
|
||||
# 00-01 Previous Volume Directory Block
|
||||
# 02-03 Next Volume Directory Block
|
||||
@ -36,7 +92,9 @@ my $key_vol_dir_blk = 2;
|
||||
# 27-28 BIT_MAP_POINTER
|
||||
# 29-2a TOTAL_BLOCKS
|
||||
#
|
||||
my $vol_dir_blk_tmpl = 'vvCa15x8nnCCCCCvvv';
|
||||
my $key_vol_dir_blk_tmpl = 'vvCa15x8nnCCCCCvvva470';
|
||||
|
||||
my $vol_dir_blk_tmpl = 'vva504';
|
||||
|
||||
#
|
||||
# Volume Bit Map
|
||||
@ -95,17 +153,81 @@ my $vol_bit_map_tmpl = 'C*';
|
||||
# 21-24 LAST_MOD
|
||||
# 25-26 HEADER_POINTER
|
||||
#
|
||||
my $file_desc_ent_tmpl = 'Ca15CnnnnnCCCa8nnCC';
|
||||
my $file_desc_ent_tmpl = 'Ca15Cvva3nnCCCvnnv';
|
||||
|
||||
# Parse a Volume Directory Block
|
||||
sub parse_vol_dir_blk {
|
||||
my $key_dir_file_desc_ent_tmpl = '';
|
||||
for (my $i = 0; $i < 12; $i++) {
|
||||
$key_dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl;
|
||||
}
|
||||
|
||||
my $dir_file_desc_ent_tmpl = '';
|
||||
for (my $i = 0; $i < 12; $i++) {
|
||||
$dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl;
|
||||
}
|
||||
|
||||
sub date_convert {
|
||||
my ($ymd, $hm) = @_;
|
||||
|
||||
#my $cr1 = unpack "b16", hex($ymd);
|
||||
|
||||
#print "cr1=$cr1\n";
|
||||
|
||||
#my $yy = substr($cr1, 0, 7);
|
||||
#print "yy=$yy\n";
|
||||
#my $year = oct('0b' . $yy);
|
||||
#print "year=$year\n";
|
||||
#my $mm = substr($cr1, 7, 4);
|
||||
#print "mm=$mm\n";
|
||||
#my $mon = oct('0b' . $mm);
|
||||
#print "mon=$mon\n";
|
||||
#my $dd = substr($cr1, 11, 5);
|
||||
#print "dd=$dd\n";
|
||||
#my $day = oct('0b' . $dd);
|
||||
#print "day=$day\n";
|
||||
|
||||
#my $cr2 = unpack "B16", $hm;
|
||||
|
||||
#print "cr2=$cr2\n";
|
||||
|
||||
#my $hh = substr($cr2, 3, 5);
|
||||
#my $hour = oct('0b' . $hh);
|
||||
#print "hour=$hour\n";
|
||||
#my $mm = substr($cr2, 10, 6);
|
||||
#my $min = oct('0b' . $mm);
|
||||
#print "min=$min\n";
|
||||
|
||||
my $year = ($ymd & 0xfe00) >> 9; # bits 9-15
|
||||
my $mon = (($ymd & 0x01e0) >> 5) - 1; # bits 5-8
|
||||
my $day = $ymd & 0x001f; # bits 0-4
|
||||
my $hour = ($hm & 0x1f00) >> 8; # bits 8-12
|
||||
my $min = $hm & 0x003f; # bits 0-5
|
||||
|
||||
return "<NO DATE>" if $day < 1;
|
||||
|
||||
#$year += 1970;
|
||||
$mon = 1 if $mon < 1;
|
||||
$day = 1 if $day < 1;
|
||||
#$year += 2000 if ($year < 50);
|
||||
#$year += 1900 if ($year < 100);
|
||||
|
||||
return sprintf("%-2d-%s-%02d %2d:%02d", $day, $months{$mon}, $year, $hour, $min);
|
||||
}
|
||||
|
||||
# Parse Key Volume Directory Block
|
||||
sub parse_key_vol_dir_blk {
|
||||
my ($buf, $dbg) = @_;
|
||||
|
||||
$debug = 1 if defined $dbg && $dbg;
|
||||
|
||||
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_yymmdd, $creation_hhmm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks) = unpack $vol_dir_blk_tmpl, $buf;
|
||||
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, $dir_ents) = unpack $key_vol_dir_blk_tmpl, $buf;
|
||||
|
||||
my $storage_type = $storage_type_name_length & 0xf0;
|
||||
print sprintf("storage_type=%02x\n", $storage_type) if $debug;
|
||||
my $name_length = $storage_type_name_length & 0x0f;
|
||||
print sprintf("name_length=%02x\n", $name_length) if $debug;
|
||||
|
||||
my $volname = substr($volume_name, 0, $name_length);
|
||||
|
||||
if ($debug) {
|
||||
print sprintf("prv_vol_dir_blk=%04x\n", $prv_vol_dir_blk);
|
||||
print sprintf("nxt_vol_dir_blk=%04x\n", $nxt_vol_dir_blk);
|
||||
@ -113,7 +235,10 @@ sub parse_vol_dir_blk {
|
||||
print sprintf("name_length=%02x\n", $name_length);
|
||||
print sprintf("volume_name=%s\n", $volume_name);
|
||||
print sprintf("volume_name=%s\n", substr($volume_name, 0, $name_length));
|
||||
print sprintf("creation=%04x%04x\n", $creation_yymmdd, $creation_hhmm);
|
||||
print sprintf("creation=%04x %04x\n", $creation_ymd, $creation_hm);
|
||||
print"\n";
|
||||
print sprintf("create_date=%s\n", date_convert($creation_ymd, $creation_hm));
|
||||
print"\n";
|
||||
print sprintf("version=%02x\n", $version);
|
||||
print sprintf("min_version=%02x\n", $min_version);
|
||||
print sprintf("access=%02x\n", $access);
|
||||
@ -124,13 +249,68 @@ sub parse_vol_dir_blk {
|
||||
print sprintf("total_blocks=%02x\n", $total_blocks);
|
||||
}
|
||||
|
||||
return $prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_yymmdd, $creation_hhmm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks;
|
||||
my @flds = unpack $key_dir_file_desc_ent_tmpl, $dir_ents;
|
||||
|
||||
my @files = ();
|
||||
for (my $i = 0; $i < 12; $i++) {
|
||||
my $storage_type_name_length = shift @flds;
|
||||
print sprintf("storage_type_name_length=%02x\n", $storage_type_name_length) if $debug;
|
||||
my $storage_type = $storage_type_name_length & 0xf0;
|
||||
print sprintf("storage_type=%02x\n", $storage_type) if $debug;
|
||||
my $name_length = $storage_type_name_length & 0x0f;
|
||||
print sprintf("name_length=%02x\n", $name_length) if $debug;
|
||||
my $file_name = shift @flds;
|
||||
print sprintf("file_name=%s\n", $file_name) if $debug;
|
||||
my $fname = substr($file_name, 0, $name_length);
|
||||
print sprintf("fname=%s\n", $fname) if $debug;
|
||||
my $file_type = shift @flds;
|
||||
print sprintf("file_type=%02x\n", $file_type) if $debug;
|
||||
my $key_pointer = shift @flds;
|
||||
print sprintf("key_pointer=%04x\n", $key_pointer) if $debug;
|
||||
my $blocks_used = shift @flds;
|
||||
print sprintf("blocks_used=%04x\n", $blocks_used) if $debug;
|
||||
my $eof = shift @flds;
|
||||
#print sprintf("eof=%04x\n", $eof);
|
||||
my $creation_ymd = shift @flds;
|
||||
print sprintf("creation_ymd=%04x\n", $creation_ymd) if $debug;
|
||||
my $creation_hm = shift @flds;
|
||||
print sprintf("creation_hm=%04x\n", $creation_hm) if $debug;
|
||||
my $cdate = date_convert($creation_ymd, $creation_hm);
|
||||
print sprintf("create_date=%s\n", $cdate) if $debug;
|
||||
my $version = shift @flds;
|
||||
print sprintf("version=%02x\n", $version) if $debug;
|
||||
my $min_version = shift @flds;
|
||||
print sprintf("min_version=%02x\n", $min_version) if $debug;
|
||||
my $access = shift @flds;
|
||||
print sprintf("access=%02x\n", $access) if $debug;
|
||||
my $aux_type = shift @flds;
|
||||
print sprintf("aux_type=%02x\n", $aux_type) if $debug;
|
||||
my $last_mod_ymd = shift @flds;
|
||||
print sprintf("last_mod_ymd=%04x\n", $last_mod_ymd) if $debug;
|
||||
my $last_mod_hm = shift @flds;
|
||||
my $mdate = date_convert($last_mod_ymd, $last_mod_hm);
|
||||
print sprintf("last_mod_hm=%04x\n", $last_mod_hm) if $debug;
|
||||
my $header_pointer = shift @flds;
|
||||
print sprintf("header_pointer=%04x\n", $header_pointer) if $debug;
|
||||
if ($storage_type != 0) {
|
||||
#print "pushing $file_name\n";
|
||||
push @files, { 'filename' => $fname, 'ftype' => $ftype{$file_type}, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type };
|
||||
}
|
||||
}
|
||||
|
||||
if ($debug) {
|
||||
foreach my $file (@files) {
|
||||
print "file=$file->{'filename'}\n";
|
||||
}
|
||||
}
|
||||
|
||||
return $prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volname, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, @files;
|
||||
}
|
||||
|
||||
#
|
||||
# Get Volume Directory Block
|
||||
# Get Key Volume Directory Block
|
||||
#
|
||||
sub get_vol_dir_blk {
|
||||
sub get_key_vol_dir_blk {
|
||||
my ($pofile, $dbg) = @_;
|
||||
|
||||
$debug = 1 if defined $dbg && $dbg;
|
||||
@ -138,6 +318,93 @@ sub get_vol_dir_blk {
|
||||
my $buf;
|
||||
|
||||
if (read_blk($pofile, $key_vol_dir_blk, \$buf)) {
|
||||
dump_blk($buf) if $debug;
|
||||
return parse_key_vol_dir_blk($buf, $debug);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Parse Volume Directory Block
|
||||
sub parse_vol_dir_blk {
|
||||
my ($buf, $dbg) = @_;
|
||||
|
||||
$debug = 1 if defined $dbg && $dbg;
|
||||
|
||||
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $dir_ents) = unpack $vol_dir_blk_tmpl, $buf;
|
||||
|
||||
if ($debug) {
|
||||
print sprintf("prv_vol_dir_blk=%04x\n", $prv_vol_dir_blk);
|
||||
print sprintf("nxt_vol_dir_blk=%04x\n", $nxt_vol_dir_blk);
|
||||
}
|
||||
|
||||
my @flds = unpack $dir_file_desc_ent_tmpl, $dir_ents;
|
||||
|
||||
my @files = ();
|
||||
for (my $i = 0; $i < 12; $i++) {
|
||||
my $storage_type_name_length = shift @flds;
|
||||
print sprintf("storage_type_name_length=%02x\n", $storage_type_name_length) if $debug;
|
||||
my $file_name = shift @flds;
|
||||
print sprintf("file_name=%s\n", $file_name) if $debug;
|
||||
my $storage_type = $storage_type_name_length & 0xf0;
|
||||
my $name_length = $storage_type_name_length & 0x0f;
|
||||
my $fname = substr($file_name, 0, $name_length);
|
||||
print sprintf("fname=%s\n", $fname) if $debug;
|
||||
my $file_type = shift @flds;
|
||||
print sprintf("file_type=%02x\n", $file_type) if $debug;
|
||||
my $key_pointer = shift @flds;
|
||||
print sprintf("key_pointer=%04x\n", $key_pointer) if $debug;
|
||||
my $blocks_used = shift @flds;
|
||||
print sprintf("blocks_used=%04x\n", $blocks_used) if $debug;
|
||||
my $eof = shift @flds;
|
||||
#print sprintf("eof=%04x\n", $eof);
|
||||
my $creation_ymd = shift @flds;
|
||||
print sprintf("creation_ymd=%04x\n", $creation_ymd) if $debug;
|
||||
my $creation_hm = shift @flds;
|
||||
print sprintf("creation_hm=%04x\n", $creation_hm) if $debug;
|
||||
my $cdate = date_convert($creation_ymd, $creation_hm);
|
||||
print sprintf("create_date=%s\n", $cdate) if $debug;
|
||||
my $version = shift @flds;
|
||||
print sprintf("version=%02x\n", $version) if $debug;
|
||||
my $min_version = shift @flds;
|
||||
print sprintf("min_version=%02x\n", $min_version) if $debug;
|
||||
my $access = shift @flds;
|
||||
print sprintf("access=%02x\n", $access) if $debug;
|
||||
my $aux_type = shift @flds;
|
||||
print sprintf("aux_type=%02x\n", $aux_type) if $debug;
|
||||
my $last_mod_ymd = shift @flds;
|
||||
print sprintf("last_mod_ymd=%04x\n", $last_mod_ymd) if $debug;
|
||||
my $last_mod_hm = shift @flds;
|
||||
print sprintf("last_mod_hm=%04x\n", $last_mod_hm) if $debug;
|
||||
my $mdate = date_convert($last_mod_ymd, $last_mod_hm);
|
||||
my $header_pointer = shift @flds;
|
||||
print sprintf("header_pointer=%04x\n", $header_pointer) if $debug;
|
||||
if ($storage_type != 0) {
|
||||
#print "pushing $file_name\n";
|
||||
push @files, { 'filename' => $fname, 'ftype' => $ftype{$file_type}, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type };
|
||||
}
|
||||
}
|
||||
|
||||
if ($debug) {
|
||||
foreach my $file (@files) {
|
||||
print "file=$file->{'filename'}\n";
|
||||
}
|
||||
}
|
||||
|
||||
return $prv_vol_dir_blk, $nxt_vol_dir_blk, @files;
|
||||
}
|
||||
|
||||
#
|
||||
# Get Volume Directory Block
|
||||
#
|
||||
sub get_vol_dir_blk {
|
||||
my ($pofile, $vol_dir_blk, $dbg) = @_;
|
||||
|
||||
$debug = 1 if defined $dbg && $dbg;
|
||||
|
||||
my $buf;
|
||||
|
||||
if (read_blk($pofile, $vol_dir_blk, \$buf)) {
|
||||
dump_blk($buf) if $debug;
|
||||
return parse_vol_dir_blk($buf, $debug);
|
||||
}
|
||||
|
||||
76
procat.pl
Normal file
76
procat.pl
Normal file
@ -0,0 +1,76 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
|
||||
use ProDOS;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
my $blk = 0x0;
|
||||
|
||||
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} elsif ($ARGV[0] eq '-b' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
|
||||
$blk = $ARGV[1];
|
||||
shift;
|
||||
shift;
|
||||
}
|
||||
}
|
||||
|
||||
my $pofile = shift or die "Must supply filename\n";
|
||||
|
||||
my $buf;
|
||||
|
||||
#if (read_blk($pofile, $blk, \$buf)) {
|
||||
# dump_blk($buf);
|
||||
|
||||
#my @bytes = unpack "C512", $buf;
|
||||
|
||||
#$bytes[8] = ord('H');
|
||||
#$bytes[9] = ord('E');
|
||||
#$bytes[10] = ord('L');
|
||||
#$bytes[11] = ord('L');
|
||||
#$bytes[12] = ord('O');
|
||||
#$bytes[13] = ord('!');
|
||||
|
||||
#my $buf = pack "C*", @bytes;
|
||||
|
||||
#if (write_blk($pofile, $blk, $buf)) {
|
||||
# if (read_blk($pofile, $blk, \$buf)) {
|
||||
# dump_blk($buf);
|
||||
# } else {
|
||||
# print "Failed final read!\n";
|
||||
# }
|
||||
#} else {
|
||||
# print "Failed write!\n";
|
||||
#}
|
||||
#} else {
|
||||
# print "Failed initial read!\n";
|
||||
#}
|
||||
|
||||
|
||||
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, @files) = get_key_vol_dir_blk($pofile, $debug);
|
||||
|
||||
print "/$volume_name\n\n";
|
||||
|
||||
print "NAME TYPE BLOCKS MODIFIED CREATED ENDFILE SUBTYPE\n\n";
|
||||
|
||||
foreach my $file (@files) {
|
||||
print sprintf("%-15s %3s %7d %16s %16s\n", $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'});
|
||||
}
|
||||
|
||||
my $vol_dir_blk = $nxt_vol_dir_blk;
|
||||
|
||||
while ($vol_dir_blk) {
|
||||
#my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, @files) = get_vol_dir_blk($pofile, $vol_dir_blk, $debug);
|
||||
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, @files) = get_vol_dir_blk($pofile, $vol_dir_blk, $debug);
|
||||
foreach my $file (@files) {
|
||||
print sprintf("%-15s %3s %7d %16s %16s\n", $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'});
|
||||
}
|
||||
$vol_dir_blk = $nxt_vol_dir_blk;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user