Make a backup file: Difference between revisions
Content deleted Content added
SqrtNegInf (talk | contribs) Added Perl example |
|||
Line 364: | Line 364: | ||
AMSDOS has automatic one-level backups which also work from Locomotive BASIC: If e.g. the file <tt>test.bas</tt> is saved, the data gets written to <tt>test.$$$</tt>. When the file is closed a preexisting <tt>test.bas</tt> gets renamed to <tt>test.bak</tt> and finally <tt>test.$$$</tt> is renamed to <tt>test.bas</tt>. (These backups affect all file types, not just BASIC source code.) |
AMSDOS has automatic one-level backups which also work from Locomotive BASIC: If e.g. the file <tt>test.bas</tt> is saved, the data gets written to <tt>test.$$$</tt>. When the file is closed a preexisting <tt>test.bas</tt> gets renamed to <tt>test.bak</tt> and finally <tt>test.$$$</tt> is renamed to <tt>test.bas</tt>. (These backups affect all file types, not just BASIC source code.) |
||
=={{header|Perl}}== |
|||
<lang perl>use strict; |
|||
use warnings; |
|||
sub backup { |
|||
my($filepath,$limit,$ext) = @_; |
|||
my $abs = readlink $filepath // $filepath; # always resolve symlinks |
|||
for my $bnum (reverse 1 .. $limit-1) { |
|||
rename "$abs$ext$bnum", "$abs$ext" . ++$bnum if -e "$abs$ext$bnum"; |
|||
} |
|||
if (-e $abs) { |
|||
if ($limit > 0) { |
|||
my $orig = $abs . $ext . '1'; |
|||
rename $abs, $orig; |
|||
open(IN, '<', $orig) or die "can't open $orig: $!"; |
|||
open(OUT, '>', $abs) or die "can't open $abs: $!"; |
|||
my $blksize = (stat IN)[11] || 2**14; # preferred block size? |
|||
my $buf; |
|||
while (my $len = sysread IN, $buf, $blksize) { |
|||
die "System read error: $!\n" if !defined $len; |
|||
my $offset = 0; |
|||
while ($len) { # Handle partial writes. |
|||
defined(my $written = syswrite OUT, $buf, $len, $offset) |
|||
or die "System write error: $!\n"; |
|||
$len -= $written; |
|||
$offset += $written; |
|||
}; |
|||
} |
|||
close(IN); |
|||
close(OUT); |
|||
} |
|||
} else { |
|||
warn "File not found: $abs" and return 0; |
|||
} |
|||
$abs |
|||
} |
|||
# back up this program |
|||
backup($0,3,'.bk');</lang> |
|||
=={{header|Perl 6}}== |
=={{header|Perl 6}}== |