From 48c704a3e2a039ac0e389447e5a9bc38de16b3e3 Mon Sep 17 00:00:00 2001
From: Leeland Heins <softwarejanitor@yahoo.com>
Date: Wed, 16 Jan 2019 09:26:26 -0600
Subject: [PATCH] Added profree.pl

---
 ProDOS.pm  | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 profree.pl | 29 +++++++++++++++++
 2 files changed, 123 insertions(+)
 create mode 100644 profree.pl

diff --git a/ProDOS.pm b/ProDOS.pm
index aecbb78..984fcb8 100644
--- a/ProDOS.pm
+++ b/ProDOS.pm
@@ -12,6 +12,8 @@ package ProDOS;
 
 use strict;
 
+use POSIX;
+
 use PO;
 
 use Exporter::Auto;
@@ -836,5 +838,97 @@ sub cat {
   }
 }
 
+sub get_master_ind_blk {
+  my ($pofile, $blk, $dbg) = @_;
+}
+
+sub get_ind_blk {
+  my ($pofile, $blk, $dbg) = @_;
+}
+
+sub find_file {
+  my ($pofile, $filename, $dbg) = @_;
+}
+
+sub read_file {
+  my ($pofile, $filename, $dbg) = @_;
+}
+
+sub parse_vol_bit_map {
+  my ($buf, $dbg) = @_;
+
+  my @blocks = ();
+
+  my (@bytes) = unpack $vol_bit_map_tmpl, $buf;
+
+  foreach my $byte (@bytes) {
+    #print sprintf("%02x ", $byte);
+    #print sprintf("%08b ", $byte);
+    push @blocks, $byte;
+  }
+  print "\n";
+
+  return @blocks;
+}
+
+sub get_vol_bit_map {
+  my ($pofile, $dbg) = @_;
+
+  $debug = 1 if defined $dbg && $dbg;
+
+  my ($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_vol_dir_blk($pofile, $debug);
+
+  my $buf;
+
+  #print sprintf("bit_map_pointer=%04x\n", $bit_map_pointer) if $debug;
+
+  # Need to use total_blocks to calculate the number of volume bit map blocks.
+  #print sprintf("total_blocks=%04x\n", $total_blocks);
+  my $num_tracks = $total_blocks / 8;
+  #print sprintf("num_tracks=%d\n", $num_tracks);
+  my $num_vol_bit_map_blks = ceil($num_tracks / 512.0);
+  #print sprintf("num_vol_bit_map_blks=%d\n", $num_vol_bit_map_blks);
+  $num_vol_bit_map_blks = 1 if $num_vol_bit_map_blks < 1;
+  #print sprintf("num_vol_bit_map_blks=%d\n", $num_vol_bit_map_blks);
+
+  my @blocks = ();
+
+  my $trk = 0;
+  for (my $blk = $bit_map_pointer; $blk < $bit_map_pointer + $num_vol_bit_map_blks; $blk++) {
+    if (read_blk($pofile, $bit_map_pointer, \$buf)) {
+      dump_blk($buf) if $debug;
+      my (@blks) = parse_vol_bit_map($buf, $debug);
+      foreach my $blk (@blks) {
+        #print sprintf("%02x ", $blk);
+        push @blocks, $blk;
+        last if $trk++ > $num_tracks;
+      }
+      print "\n";
+    }
+  }
+
+  return @blocks;
+}
+
+sub freemap {
+  my ($pofile, $dbg) = @_;
+
+  $debug = 1 if defined $dbg && $dbg;
+
+  my (@blocks) = get_vol_bit_map($pofile, $debug);
+
+  print "    12345678\n";
+  print "   +--------\n";
+
+  my $trk = 0;
+  foreach my $byte (@blocks) {
+    my $bits = sprintf("%08b", $byte);
+    $bits =~ s/[0]/ /g;
+    $bits =~ s/[1]/\*/g;
+    print sprintf("%2d |%s\n", $trk++, $bits);
+  }
+  print "\n";
+}
+
 1;
 
diff --git a/profree.pl b/profree.pl
new file mode 100644
index 0000000..ac576c2
--- /dev/null
+++ b/profree.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/perl -w
+
+#
+# profree.pl:
+#
+# Utility to get a free sector map of an Apple II ProDOS volume.
+#
+# 20190116 LSH
+#
+
+use strict;
+
+use ProDOS;
+
+my $debug = 0;
+
+while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
+  if ($ARGV[0] eq '-d') {
+    $debug = 1;
+    shift;
+  }
+}
+
+my $pofile = shift or die "Must supply filename\n";
+
+freemap($pofile, $debug);
+
+1;
+