#!/usr/bin/perl -w package ProDOS; # # ProDOS.pm: # # Module to access Apple II ProDOS volumes. # # 20190115 LSH # use strict; use PO; use Exporter::Auto; my $debug = 0; # ProDOS file types my %ftype = ( # $0x Types: General # 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', # 07 FNT Apple /// Font 0x07 => 'FNT', # 08 FOT HiRes/Double HiRes Graphics 0x08 => 'FOT', # 09 BA3 Apple III BASIC Program 0x09 => 'BA3', # 0A DA3 Apple III BASIC Data 0x0a => 'DA3', # 0B WPF Generic Word Processing 0x0b => 'WPF', # 0C SOS SOS System File 0x0c => 'SOS', # f DIR Directory file 0x0f => 'DIR', # $1x Types: Productivity # 19 ADB AppleWorks data base file 0x19 => 'ADB', # 1a AWP AppleWorks word processing file 0x1a => 'AWP', # 1b ASP AppleWorks spreadsheet file 0x1b => 'ASP', # $2x Types: Code # $20 TDM Desktop Manager File 0x20 => 'TDM', # $21 IPS Instant Pascal Source 0x21 => 'IPS', # $22 UPV UCSD Pascal Volume 0x22 => 'UPV', # $29 3SD SOS Directory 0x29 => '3SD', # $2A 8SC Source Code 0x2a => '8SC', # $2B 8OB Object Code 0x2b => '8OB', # $2C 8IC Interpreted Code 0x2c => '8IC', # $8003 - Apex Program File # $2D 8LD Language Data 0x2d => '8LD', # $2E P8C ProDOS 8 Code Module 0x2e => 'P8C', # $4x Types: Miscellaneous # $41 OCR Optical Character Recognition 0x41 => 'OCR', # $42 FTD File Type Definitions 0x42 => 'FTD', # $5x Types: Apple IIgs General # $50 GWP Apple IIgs Word Processing 0x50 => 'GWP', # $5445 - Teach # $8001 - DeluxeWrite # $8010 - AppleWorks GS # $51 GSS Apple IIgs Spreadsheet 0x51 => 'GSS', # $8010 - AppleWorks GS # $52 GDB Apple IIgs Database 0x52 => 'GDB', # $8010 - AppleWorks GS # $8011 - AppleWorks GS Template # $8013 - GSAS # $53 DRW Object Oriented Graphics 0x53 => 'DRW', # $8010 - AppleWorks GS # $54 GDP Apple IIgs Desktop Publishing 0x54 => 'GDP', # $8002 - GraphicWriter # $8010 - AppleWorks GS # $55 HMD HyperMedia 0x55 => 'HMD', # $0001 - HyperCard GS # $8001 - Tutor-Tech # $8002 - HyperStudio # $8003 - Nexus # $56 EDU Educational Program Data 0x56 => 'EDU', # $57 STN Stationery 0x57 => 'STN', # $58 HLP Help File 0x58 => 'HLP', # $59 COM Communications 0x59 => 'COM', # $8010 - AppleWorks GS # $5A CFG Configuration 0x5a => 'CFG', # $5B ANM Animation 0x5b => 'ANM', # $5C MUM Multimedia 0x5c => 'MUM', # $5D ENT Entertainment 0x5d => 'ENT', # $5E DVU Development Utility 0x5e => 'DVU', # $6x Types: PC Transporter # $60 PRE PC Pre-Boot 0x60 => 'PRE', # $6B BIO PC BIOS 0x6b => 'BIO', # $66 NCF ProDOS File Navigator Command File 0x66 => 'NCF', # $6D DVR PC Driver 0x6d => 'DVR', # $6E PRE PC Pre-Boot 0x6e => 'PRE', # $6F HDV PC Hard Disk Image 0x6f => 'HDV', # $7x Types: Kreative Software # $70 SN2 Sabine's Notebook 2.0 0x70 => 'SN2', # $71 KMT 0x71 => 'KMT', # $72 DSR 0x72 => 'DSR', # $73 BAN 0x73 => 'BAN', # $74 CG7 0x74 => 'CG7', # $75 TNJ 0x75 => 'TNJ', # $76 SA7 0x76 => 'SA7', # $77 KES 0x77 => 'KES', # $78 JAP 0x78 => 'JAP', # $79 CSL 0x79 => 'CSL', # $7A TME 0x7a => 'TME', # $7B TLB 0x7b => 'TLB', # $7C MR7 0x7c => 'MR7', # $7D MLR Mika City 0x7d => 'MLR', # $005C - Script # $C7AB - Color Table # $CDEF - Character Definition # $7E MMM 0x7e => 'MMM', # $7F JCP 0x7f => 'JCP', # $8x Types: GEOS # $80 GES System File 0x80 => 'GES', # $81 GEA Desk Accessory 0x81 => 'GEA', # $82 GEO Application 0x82 => 'GEO', # $83 GED Document 0x83 => 'GED', # $84 GEF Font 0x84 => 'GEF', # $85 GEP Printer Driver 0x85 => 'GEP', # $86 GEI Input Driver 0x86 => 'GEI', # $87 GEX Auxiliary Driver 0x87 => 'GEX', # $89 GEV Swap File 0x89 => 'GEV', # $8B GEC Clock Driver 0x8b => 'GEC', # $8C GEK Interface Card Driver 0x8c => 'GEK', # $8D GEW Formatting Data 0x8d => 'GEW', # $Ax Types: Apple IIgs BASIC # $A0 WP WordPerfect 0xa0 => 'WP ', # $AB GSB Apple IIgs BASIC Program 0xab => 'GSB', # $AC TDF Apple IIgs BASIC TDF 0xac => 'TDF', # $AD BDF Apple IIgs BASIC Data 0xad => 'BDF', # $Bx Types: Apple IIgs System # $B0 SRC Apple IIgs Source Code 0xb0 => 'SRC', # $B1 OBJ Apple IIgs Object Code 0xb1 => 'OBJ', # $B2 LIB Apple IIgs Library 0xb2 => 'LIB', # $B3 S16 Apple IIgs Application Program 0xb3 => 'S16', # $B4 RTL Apple IIgs Runtime Library 0xb4 => 'RTL', # $B5 EXE Apple IIgs Shell Script 0xb5 => 'EXE', # $B6 PIF Apple IIgs Permanent INIT 0xb6 => 'PIF', # $B7 TIF Apple IIgs Temporary INIT 0xb7 => 'TIF', # $B8 NDA Apple IIgs New Desk Accessory 0xb8 => 'NDA', # $B9 CDA Apple IIgs Classic Desk Accessory 0xb9 => 'CDA', # $BA TOL Apple IIgs Tool 0xba => 'TOL', # $BB DRV Apple IIgs Device Driver 0xbb => 'DRV', # $BC LDF Apple IIgs Generic Load File 0xbc => 'LDF', # $4001 - Nifty List Module # $4002 - Super Info Module # $4004 - Twilight Module # $4083 - Marinetti Link Layer Module # $BD FST Apple IIgs File System Translator 0xbd => 'FST', # $BF DOC Apple IIgs Document 0xbf => 'DOC', # $Cx Types: Graphics # $C0 PNT Apple IIgs Packed Super HiRes 0xc0 => 'PNT', # $0001 - Packed Super HiRes # $0002 - Apple Preferred Format # $0003 - Packed QuickDraw II PICT # $C1 PIC Apple IIgs Super HiRes 0xc1 => 'PIC', # $0001 - QuickDraw PICT # $0002 - Super HiRes 3200 # $C2 ANI PaintWorks Animation 0xc2 => 'ANI', # $C3 PAL PaintWorks Palette 0xc3 => 'PAL', # $C5 OOG Object-Oriented Graphics 0xc5 => 'OOG', # $C6 SCR Script 0xc6 => 'SCR', # $C7 CDV Apple IIgs Control Panel 0xc7 => 'CDV', # $C8 FON Apple IIgs Font 0xc8 => 'FON', # $0000 - QuickDraw Bitmap Font # $0001 - Pointless TrueType Font # $C9 FND Apple IIgs Finder Data 0xc9 => 'FND', # $CA ICN Apple IIgs Icon File 0xca => 'ICN', # $Dx Types: Audio # $D5 MUS Music 0xd5 => 'MUS', # $D6 INS Instrument 0xd6 => 'INS', # $D7 MDI MIDI 0xd7 => 'MDI', # $D8 SND Apple IIgs Audio 0xd8 => 'SND', # $0000 - AIFF # $0001 - AIFF-C # $0002 - ASIF Instrument # $0003 - Sound Resource # $0004 - MIDI Synth Wave # $8001 - HyperStudio Sound # $DB DBM DB Master Document 0xdb => 'DBM', # $Ex Types: Miscellaneous # $E0 LBR Archive 0xe0 => 'LBR', # $0000 - ALU # $0001 - AppleSingle # $0002 - AppleDouble Header # $0003 - AppleDouble Data # $8000 - Binary II # $8001 - AppleLink ACU # $8002 - ShrinkIt # $E2 ATK AppleTalk Data 0xe2 => 'ATK', # $FFFF - EasyMount Alias # $EE R16 EDASM 816 Relocatable Code 0xee => 'R16', # ef PAS ProDOS PASCAL file 0xef => 'PAS', # $Fx Types: System # f0 CMD ProDOS added command file 0xf0 => 'CMD', # f1-f8 User defined file types 1 through 8 0xf1 => 'OVL', 0xf2 => 'UD2', 0xf3 => 'UD3', 0xf4 => 'UD4', 0xf5 => 'BAT', 0xf6 => 'UD6', 0xf7 => 'UD7', 0xf8 => 'PRG', # $F9 P16 ProDOS-16 System File 0xf9 => 'P16', # fa INT Integer BASIC Program 0xfa => 'INT', # fb IVR Integer BASIC Variables 0xfb => 'IVR', # 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', ); # # Months for catalog date format. # 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', ); # Default key volume directory block. my $key_vol_dir_blk = 2; # # Key Volume Directory Block # # 00-01 Previous Volume Directory Block # 02-03 Next Volume Directory Block # # Volumne Directory Header # # 04 STORAGE_TYPE/NAME_LENGTH # fx where x is length of VOLUME_NAME # 05-13 VOLUME_NAME # 14-1b Not used # 1c-1f CREATION # 0-1 yyyyyyymmmmddddd year/month/day # 2-3 000hhhhh00mmmmmm hours/minues # 20 VERSION # 21 MIN_VERSION # 22 ACCESS # 23 ENTRY_LENGTH # 24 ENTRIES_PER_BLOCK # 25-26 FILE_COUNT # 27-28 BIT_MAP_POINTER # 29-2a TOTAL_BLOCKS # my $key_vol_dir_blk_tmpl = 'vvCa15x8vvCCCCCvvva470'; my $vol_dir_blk_tmpl = 'vva504'; # # Volume Bit Map # my $vol_bit_map_tmpl = 'C*'; # # File Descriptive Entries # # 00 STORAGE_TYPE/NAME_LENGTH # 0x Deleted entry. Available for reuse. # 1x File is a seedling file (only one block) # 2x File is a sapling file (2-256 blocks) # 3x File is a tree file (257-32768 blocks) # dx File is a subdirectory # ex Reserved for Subdirectory Header entry # fx Reserved for Volume Directory Header entry # x is the length of FILE_NAME # 01-0f FILE_NAME # 10 FILE_TYPE # 00 Typeless file # 01 BAD Bad block(s) file # 04 TXT Text file (ASCII text, msb off) # 06 BIN Binary file (8-bit binary image) # 0f DIR Directory file # 19 ADB AppleWorks data base file # 1a AWP AppleWorks word processing file # 1b ASP AppleWorks spreadsheet file # ef PAS ProDOS PASCAL file # f0 CMD ProDOS added command file # f1-f8 User defined file types 1 through 8 # fc BAS Applesoft BASIC program file # fd VAR Applesoft stored variables file # fe REL Relocatable object module file (EDASM) # ff SYS ProDOS system file # 11-12 KEY_POINTER # 13-14 BLOCKS_USED # 15-17 EOF # 18-1b CREATION # 0-1 yyyyyyymmmmddddd year/month/day # 2-3 000hhhhh00mmmmmm hours/minues # 1c VERSION # 1d MIN_VERSION # 1e ACCESS # 80 File may be destroyed # 40 File may be renamed # 20 File has changed since last backup # 02 File may be written to # 01 File may be read # 1f-20 AUX_TYPE # TXT Random access record length (L from OPEN) # BIN Load address for binary image (A from BSAVE) # BAS Load address for program image (when SAVEd) # VAR Address of compressed variables inmage (when STOREd) # SYS Load address for system program (usually $2000) # 21-24 LAST_MOD # 25-26 HEADER_POINTER # my $file_desc_ent_tmpl = 'Ca15Cvva3vvCCCvvvv'; my $key_dir_file_desc_ent_tmpl = ''; my $subdir_hdr_file_desc_ent_tmpl = ''; for (my $i = 0; $i < 12; $i++) { $key_dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl; $subdir_hdr_file_desc_ent_tmpl .= $file_desc_ent_tmpl; } my $dir_file_desc_ent_tmpl = ''; my $subdir_file_desc_ent_tmpl = ''; for (my $i = 0; $i < 12; $i++) { $dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl; $subdir_file_desc_ent_tmpl .= $file_desc_ent_tmpl; } # # Subdirectory Header # # 00-01 Previous Subdirectory Block # 02-03 Next Subdirectory Block # # 04 STORAGE_TYPE/NAME_LENGTH # ex where x is length of SUBDIR NAME # # 05-13 SUBDIR_NAME # 14 Must contain $75 # 15-1b Reserved for future use # 1c-1f CREATION # 0-1 yyyyyyymmmmddddd year/month/day # 2-3 000hhhhh00mmmmmm hours/minues # 20 VERSION # 21 MIN_VERSION # 22 ACCESS # 23 ENTRY_LENGTH # 24 ENTRIES_PER_BLOCK # 25-26 FILE_COUNT # 27-28 PARENT_POINTER # 29 PARENT_ENTRY # 2a PARENT_ENTRY_LENGTH # my $subdir_hdr_blk_tmpl = 'vvCa15Cx7vvCCCCCvvCCa469'; # # Convert a ProDOS date to DD-MMM-YY string. # sub date_convert { my ($ymd, $hm) = @_; return "" unless (defined $ymd && defined $hm && $ymd != 0); my $year = ($ymd & 0xfe00) >> 9; # bits 9-15 my $mon = ($ymd & 0x01e0) >> 5; # 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 $mon = 0 if $mon > 12; return "" if $mon < 1; 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_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; my $name_length = $storage_type_name_length & 0x0f; my $volname = substr($volume_name, 0, $name_length); 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; my $storage_type = $storage_type_name_length & 0xf0; my $name_length = $storage_type_name_length & 0x0f; my $file_name = shift @flds; my $fname = substr($file_name, 0, $name_length); my $file_type = shift @flds; my $key_pointer = shift @flds; my $blocks_used = shift @flds; my $eof = shift @flds; my ($e1, $e2, $e3) = unpack "C*", $eof; my $endfile = (($e3 << 16) + ($e2 << 8) + $e1); my $creation_ymd = shift @flds; my $creation_hm = shift @flds; my $cdate = date_convert($creation_ymd, $creation_hm); my $version = shift @flds; my $min_version = shift @flds; my $access = shift @flds; my $aux_type = shift @flds; my $atype = ''; if ($file_type == 0x06) { $atype = sprintf("A=\$%04X", $aux_type); } my $last_mod_ymd = shift @flds; my $last_mod_hm = shift @flds; my $mdate = date_convert($last_mod_ymd, $last_mod_hm); my $header_pointer = shift @flds; if ($storage_type != 0) { my $f_type = $ftype{$file_type}; $f_type = sprintf("\$%02x", $file_type) unless defined $f_type; push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer }; } } 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 Key Volume Directory Block # sub get_key_vol_dir_blk { my ($pofile, $dbg) = @_; $debug = 1 if defined $dbg && $dbg; 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; 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; my $file_name = shift @flds; my $storage_type = $storage_type_name_length & 0xf0; my $name_length = $storage_type_name_length & 0x0f; my $fname = substr($file_name, 0, $name_length); my $file_type = shift @flds; my $key_pointer = shift @flds; my $blocks_used = shift @flds; my $eof = shift @flds; my ($e1, $e2, $e3) = unpack "C*", $eof; my $endfile = (($e3 << 16) + ($e2 << 8) + $e1); my $creation_ymd = shift @flds; my $creation_hm = shift @flds; my $cdate = date_convert($creation_ymd, $creation_hm); my $version = shift @flds; my $min_version = shift @flds; my $access = shift @flds; my $aux_type = shift @flds; my $atype = ''; if ($file_type == 0x06) { $atype = sprintf("A=\$%04X", $aux_type); } my $last_mod_ymd = shift @flds; my $last_mod_hm = shift @flds; my $mdate = date_convert($last_mod_ymd, $last_mod_hm); my $header_pointer = shift @flds; if ($storage_type != 0) { my $f_type = $ftype{$file_type}; $f_type = sprintf("\$%02x", $file_type) unless defined $f_type; push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer }; } } 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); } return 0; } # Parse Key Volume Directory Block sub parse_subdir_hdr_blk { my ($buf, $dbg) = @_; $debug = 1 if defined $dbg && $dbg; my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $foo, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, $dir_ents) = unpack $subdir_hdr_blk_tmpl, $buf; my $storage_type = $storage_type_name_length & 0xf0; my $name_length = $storage_type_name_length & 0x0f; my $subdir_nm = substr($subdir_name, 0, $name_length); my @flds = unpack $subdir_hdr_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; 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; my $blocks_used = shift @flds; my $eof = shift @flds; my ($e1, $e2, $e3) = unpack "C*", $eof; my $endfile = (($e3 << 16) + ($e2 << 8) + $e1); my $creation_ymd = shift @flds; my $creation_hm = shift @flds; my $cdate = date_convert($creation_ymd, $creation_hm); my $version = shift @flds; my $min_version = shift @flds; my $access = shift @flds; my $aux_type = shift @flds; my $atype = ''; if ($file_type == 0x06) { $atype = sprintf("A=\$%04X", $aux_type); } my $last_mod_ymd = shift @flds; my $last_mod_hm = shift @flds; my $mdate = date_convert($last_mod_ymd, $last_mod_hm); my $header_pointer = shift @flds; if ($storage_type != 0) { my $f_type = $ftype{$file_type}; $f_type = sprintf("\$%02x", $file_type) unless defined $f_type; push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer }; } } return $prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_nm, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @files; } sub get_subdir_hdr { my ($pofile, $subdir_blk, $dbg) = @_; $debug = 1 if defined $dbg && $dbg; my $buf; if (read_blk($pofile, $subdir_blk, \$buf)) { dump_blk($buf) if $debug; return parse_subdir_hdr_blk($buf, $debug); } return 0; } sub list_files { my ($pofile, $pre, $dirname, $files) = @_; print "$pre/$dirname\n"; foreach my $file (@{$files}) { my $lck = ' '; if ($file->{'access'} == 0x01) { $lck = '*'; } print sprintf("$pre%s%-15s %3s %7d %16s %16s %7s %s\n", $lck, $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}, $file->{'eof'}, $file->{'atype'}); if ($file->{'ftype'} eq 'DIR') { my $subdir_blk = $file->{'keyptr'}; my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @subfiles) = get_subdir_hdr($pofile, $subdir_blk, $debug); list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles); } } } # # Get disk catalog. # sub cat { my ($pofile, $dbg) = @_; $debug = 1 if defined $dbg && $dbg; 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) { my $lck = ' '; if ($file->{'access'} == 0x01) { $lck = '*'; } print sprintf("%s%-15s %3s %7d %16s %16s %7s %s\n", $lck, $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}, $file->{'eof'}, $file->{'atype'}); if ($file->{'ftype'} eq 'DIR') { my $subdir_blk = $file->{'keyptr'}; my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @subfiles) = get_subdir_hdr($pofile, $subdir_blk, $debug); my $pre = ' '; list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles); } } my $vol_dir_blk = $nxt_vol_dir_blk; while ($vol_dir_blk) { my ($prv_vol_dir_blk, $nxt_vol_dir_blk, @files) = get_vol_dir_blk($pofile, $vol_dir_blk, $debug); foreach my $file (@files) { my $lck = ' '; if ($file->{'access'} == 0x01) { $lck = '*'; } print sprintf("%s%-15s %3s %7d %16s %16s %7s %s\n", $lck, $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}, $file->{'eof'}, $file->{'atype'}); if ($file->{'ftype'} eq 'DIR') { my $subdir_blk = $file->{'keyptr'}; my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @subfiles) = get_subdir_hdr($pofile, $subdir_blk, $debug); my $pre = ' '; list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles); } } $vol_dir_blk = $nxt_vol_dir_blk; } } 1;