Added proformat and proundelete

ProDOS.pm

@@ -1988,7 +1988,18 @@ sub write_file {
 
   print "pofile=$pofile filename=$filename mode=$mode conv=$conv apple_filename=$apple_filename\n" if $debug;
 
-  return 0 if ! -e $filename;
+  # Need to make sure the file doesn't already exist.
+  my ($storage_type, $t_file_type, $t_key_pointer, $blocks_used, $eof, $t_header_pointer, $t_i) = find_file($pofile, $filename, $debug);
+  if ($storage_type != 0) {
+    print "File exists\n";
+    return 0;
+  }
+
+  # Check for existance of source file.
+  if (! -e $filename) {
+    print "File $filename does not exist.\n";
+    return 0;
+  }
 
   # Get size of input file
   my $fsize = -s $filename;
@@ -1997,20 +2008,13 @@ sub write_file {
   my $numblocks = int($fsize / 512) + (($fsize % 512) ? 1 : 0);
   print "numblocks=$numblocks\n";
 
-  my $blocks_used = $numblocks;
+  $blocks_used = $numblocks;
 
   # Get list of free blocks.
   my @free_blocks = get_free_blocks($pofile, $debug);
 
   my $free_count = scalar @free_blocks;
 
-  # Need to make sure the file doesn't already exist.
-  my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, $debug);
-  if ($storage_type != 0) {
-    print "File exists\n";
-    return 0;
-  }
-
   if ($free_count < $numblocks) {
     print "Not enough space on volume, $free_count free blocks, need $numblocks\n";
     return 0;
@@ -2943,5 +2947,39 @@ sub create_subdir {
   return $rv;
 }
 
+#
+# Undelete a file
+#
+sub undelete_file {
+  my ($pofile, $filename, $dbg) = @_;
+
+  $debug = 1 if defined $dbg && $dbg;
+
+  print "pofile=$pofile filename=$filename\n" if $debug;
+
+  my $rv = 1;
+
+##FIXME
+
+  return $rv;
+}
+
+#
+# Format a volume
+#
+sub format_volume {
+  my ($pofile, $blocks, $volume_name, $dbg) = @_;
+
+  $debug = 1 if defined $dbg && $dbg;
+
+  print "pofile=$pofile blocks=$blocks volume_name=$volume_name\n" if $debug;
+
+  my $rv = 1;
+
+##FIXME
+
+  return $rv;
+}
+
 1;
 

README

@@ -11,4 +11,6 @@ prolock.pl -- partially working
 prounlock.pl -- partially working
 procopy.pl -- started
 procreate.pl -- partially working
+proundelete.pl -- started
+proformat.pl -- started
 

proformat.pl

@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+
+#
+# proformat.pl:
+#
+# Utility to create a subdirectory on an Apple II ProDOS .po disk image.
+#
+# 20190308 LSH
+#
+
+use strict;
+
+use ProDOS;
+
+my $debug = 0;
+my $blocks = 280;  # Default size of 5.25" floppy.
+my $volume_name = 'NEWDISK';
+
+while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
+  # Debug
+  if ($ARGV[0] eq '-d') {
+    $debug = 1;
+    shift;
+  # Number of blocks for volume
+  } elsif ($ARGV[0] eq '-b' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
+    $blocks = $ARGV[1];
+    shift;
+    shift;
+  # Volume Name
+  } elsif ($ARGV[0] eq '-v' && defined $ARGV[1] && $ARGV[1] =~ /^\S+$/) {
+    $volume_name = substr($ARGV[1], 0, 15);
+    shift;
+    shift;
+  } else {
+    die "Unknown command line argument $ARGV[0]\n";
+  }
+}
+
+my $pofile = shift or die "Must supply .po filename\n";
+
+format_volume($pofile, $blocks, $volume_name, $debug);
+
+1;
+

proundelete.pl

@@ -0,0 +1,33 @@
+#!/usr/bin/perl -w
+
+#
+# proundelete.pl:
+#
+# Utility to undelete a file on an Apple II ProDOS .po disk image.
+#
+# 20190308 LSH
+#
+
+use strict;
+
+use ProDOS;
+
+my $debug = 0;
+
+while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
+  # Debug
+  if ($ARGV[0] eq '-d') {
+    $debug = 1;
+    shift;
+  } else {
+    die "Unknown command line argument $ARGV[0]\n";
+  }
+}
+
+my $pofile = shift or die "Must supply .po filename\n";
+my $filename = shift or die "Must supply filename (on disk image)\n";
+
+undelete_file($pofile, $filename, $debug);
+
+1;
+