Added prolock and prounlock

This commit is contained in:
Leeland Heins 2019-02-28 14:27:00 -06:00 committed by GitHub
parent 92c92f5b13
commit 058f38a5ca
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 90 additions and 0 deletions

View File

@ -1434,5 +1434,27 @@ sub copy_file {
print "pofile=$pofile filename=$filename copy_filename=$copy_filename\n" if $debug;
}
#
# Lock a file
#
sub lock_file {
my ($pofile, $filename, $dbg) = @_;
$debug = 1 if defined $dbg && $dbg;
print "pofile=$pofile filename=$filename\n" if $debug;
}
#
# Unlock a file
#
sub unlock_file {
my ($pofile, $filename, $dbg) = @_;
$debug = 1 if defined $dbg && $dbg;
print "pofile=$pofile filename=$filename\n" if $debug;
}
1;

2
README
View File

@ -8,4 +8,6 @@ prowrite.pl -- started
prorename.pl -- started
prodelete.pl -- started
procopy.pl -- started
prolock.pl -- started
prounlock.pl -- started

33
prolock.pl Normal file
View File

@ -0,0 +1,33 @@
#!/usr/bin/perl -w
#
# prolock.pl:
#
# Utility to 'lock' a file on an Apple II ProDOS .po disk image.
#
# 20190228 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";
lock_file($pofile, $filename, $debug);
1;

33
prounlock.pl Normal file
View File

@ -0,0 +1,33 @@
#!/usr/bin/perl -w
#
# prounlock.pl:
#
# Utility to 'unlock' a file on an Apple II ProDOS .po disk image.
#
# 20190228 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";
unlock_file($pofile, $filename, $debug);
1;