Added prolock and prounlock
This commit is contained in:
parent
92c92f5b13
commit
058f38a5ca
22
ProDOS.pm
22
ProDOS.pm
|
@ -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
2
README
|
@ -8,4 +8,6 @@ prowrite.pl -- started
|
|||
prorename.pl -- started
|
||||
prodelete.pl -- started
|
||||
procopy.pl -- started
|
||||
prolock.pl -- started
|
||||
prounlock.pl -- started
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
Loading…
Reference in New Issue