summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org>2020-01-19 12:02:26 (GMT)
committer Sergey Poznyakoff <gray@gnu.org>2020-01-19 12:03:55 (GMT)
commit4e1f50027c7d6fc59d47d932a2a37860e928ebb5 (patch) (side-by-side diff)
tree022335ab7b86361950ae133de493fc76d33b05b0
parentfdea256ea75e0ca072915d7522564052a9f683f0 (diff)
downloadfile-backup-4e1f50027c7d6fc59d47d932a2a37860e928ebb5.tar.gz
file-backup-4e1f50027c7d6fc59d47d932a2a37860e928ebb5.tar.bz2
Improve the API
Optional keyword arguments can be used to control error handling and to specify the directory where to create backup copies.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--lib/File/Backup.pm154
-rw-r--r--t/00simple.t24
-rw-r--r--t/01numbered.t15
-rw-r--r--t/02auto.t24
-rw-r--r--t/03backup.t33
5 files changed, 221 insertions, 29 deletions
diff --git a/lib/File/Backup.pm b/lib/File/Backup.pm
index 7e1eb5f..3bc18aa 100644
--- a/lib/File/Backup.pm
+++ b/lib/File/Backup.pm
@@ -4,6 +4,7 @@ use warnings;
use File::Copy;
use File::Temp;
use File::Basename;
+use File::Spec;
use Exporter;
use re '/aa';
use Carp;
@@ -48,7 +49,18 @@ my %backup_func = (
);
sub backup {
- my ($file, $type) = @_;
+ my $file = shift;
+
+ my ($type, %opts);
+ if (@_ == 1) {
+ $type = shift;
+ } elsif (@_ % 2 == 0) {
+ %opts = @_;
+ $type = delete $opts{type};
+ } else {
+ croak "wrong number of arguments";
+ }
+
unless (defined($type)) {
my $v = $ENV{VERSION_CONTROL} || BACKUP_AUTO;
if (exists($envtrans{$v})) {
@@ -57,24 +69,61 @@ sub backup {
$type = BACKUP_AUTO;
}
}
- &{$backup_func{$type}}($file);
+ &{$backup_func{$type}}($file, %opts);
}
sub backup_simple {
- my ($file_name) = @_;
+ my $file_name = shift;
+ local %_ = @_;
+ my $error = delete $_{error};
+ my $dir = delete $_{dir};
+ croak "unrecognized keyword arguments" if keys %_;
my $backup_name = $file_name . '~';
+ if ($dir) {
+ $backup_name = File::Spec->catfile($dir, $backup_name);
+ }
copy($file_name, $backup_name)
- or croak "failed to copy $file_name to $backup_name: $!";
+ or return _backup_error($error,
+ "failed to copy $file_name to $backup_name: $!");
return $backup_name;
}
+sub _backup_error {
+ my ($error, $msg) = @_;
+ if ($error) {
+ $$error = $msg;
+ return undef;
+ }
+ confess $msg;
+}
+
sub backup_numbered_opt {
- my ($file_name, $if_exists) = @_;
+ my $file_name = shift;
+
+ my ($if_exists, $error, $dir);
+ if (@_ == 1) {
+ $if_exists = shift;
+ } elsif (@_ % 2 == 0) {
+ local %_ = @_;
+ $if_exists = delete $_{if_exists};
+ $error = delete $_{error};
+ $dir = delete $_{dir};
+ croak "unrecognized keyword arguments" if keys %_;
+ } else {
+ croak "wrong number of arguments";
+ }
+
+ my $fh = eval { File::Temp->new(DIR => $dir || dirname($file_name)) };
+ if ($@) {
+ return _backup_error($error, $@);
+ }
- my $fh = File::Temp->new(DIR => dirname($file_name));
- copy($file_name, $fh) or
- croak "failed to make a temporary copy of $file_name: $!";
+ copy($file_name, $fh)
+ or return _backup_error($error,
+ "failed to make a temporary copy of $file_name: $!");
+ my $pat = $dir ? File::Spec->catfile($dir, "$file_name.~*~")
+ : "$file_name.~*~";
my $num = (sort { $b <=> $a }
map {
if (/.+\.~(\d+)~$/) {
@@ -82,37 +131,45 @@ sub backup_numbered_opt {
} else {
()
}
- } glob("$file_name.~*~"))[0];
+ } glob($pat))[0];
if (!defined($num)) {
- return backup_simple($file_name) if $if_exists;
+ return backup_simple($file_name, error => $error, dir => $dir)
+ if $if_exists;
$num = '1';
}
my $backup_name;
while (1) {
$backup_name = "$file_name.~$num~";
+ if ($dir) {
+ $backup_name = File::Spec->catfile($dir, $backup_name);
+ }
last if symlink($fh->filename, $backup_name);
unless ($!{EEXIST}) {
- croak "can't link ".$fh->filename." to $backup_name: $!";
+ return _backup_error("can't link "
+ . $fh->filename .
+ " to $backup_name: $!");
}
++$num;
}
unless (rename($fh->filename, $backup_name)) {
- croak "can't rename temporary file to $backup_name: $!";
+ return _backup_error("can't rename temporary file to $backup_name: $!");
}
return $backup_name;
}
sub backup_numbered {
- my ($file_name) = @_;
- backup_numbered_opt($file_name, 0);
+ my ($file_name, %opts) = @_;
+ $opts{if_exists} = 0;
+ backup_numbered_opt($file_name, %opts);
}
sub backup_auto {
- my ($file_name) = @_;
- backup_numbered_opt($file_name, 1);
+ my ($file_name, %opts) = @_;
+ $opts{if_exists} = 1;
+ backup_numbered_opt($file_name, %opts);
}
1;
@@ -130,6 +187,12 @@ File::Backup - create a backup of the file.
$backup_name = backup($file_name, BACKUP_NUMBERED);
+ $backup_name = backup($file_name, type => BACKUP_NUMBERED,
+ dir => $directory, error => \my $error);
+ if (!$backup_name) {
+ warn $error;
+ }
+
=head1 DESCRIPTION
The File::Backup module provides functions for creating backup copies of
@@ -143,9 +206,11 @@ called F<test.~1~>, F<test.~2~> and so on.
=head2 backup
- $backup_name = backup($orig_name)
+ $backup_name = backup($orig_name);
- $backup_name = backup($orig_name, $scheme)
+ $backup_name = backup($orig_name, $scheme);
+
+ $backup_name = backup($orig_name, %opts);
The B<backup> function is the principal interface for managing backup
copies. Its first argument specifies the name of the existing file for
@@ -202,29 +267,72 @@ above, B<BACKUP_AUTO> is assumed.
The function returns the name of the backup file it created (C<undef> if
called with B<BACKUP_NONE>). On error, it calls B<croak()>.
+When used in the third form, the B<%opts> are keyword arguments that
+control the function behavior. The following arguments are understood:
+
+=over 4
+
+=item type =E<gt> $scheme
+
+Request a particular backup naming scheme. The following two calls are
+equivalent:
+
+ backup($file, type => BACKUP_SIMPLE)
+
+ backup($file, BACKUP_SIMPLE)
+
+=item dir =E<gt> $directory
+
+Create backup files in I<$directory>. The directory must exist and be
+writable.
+
+By default backup files are created in the same directory as the original file.
+
+=item error =E<gt> $ref
+
+This changes default error handling. Instead of croaking on error, the
+error message will be stored in I<$ref> (which should be a reference to
+a scalar) and C<undef> will be returned.
+
+This can be used for an elaborate error handling and recovery, e.g.:
+
+ $bname = backup($file, \my $err);
+ unless ($bname && defined($err)) {
+ error("can't backup file $file: $err");
+ # perhaps more code follows
+ }
+ ...
+
+=back
+
The following functions are available for using a specific backup naming
scheme. These functions must be exported explicitly.
=head2 backup_simple
use File::Backup qw(backup_simple);
- $backup_name = backup_simple($orig_name);
+ $backup_name = backup_simple($orig_name, %opts);
-Creates simple backup.
+Creates simple backup. Optional I<%opts> have the same meaning as in
+B<backup>, except that, obviously, B<type> keyword is not accepted.
+
=head2 backup_numbered
use File::Backup qw(backup_numbered);
- $backup_name = backup_numbered($orig_name);
+ $backup_name = backup_numbered($orig_name, %opts);
-Creates numbered backup.
+Creates numbered backup. See above for a description of I<%opts>.
=head2 backup_auto
use File::Backup qw(backup_auto);
- $backup_name = backup_auto($orig_name);
+ $backup_name = backup_auto($orig_name, %opts);
Creates numbered backup if any numbered backup version already exists for
the file. Otherwise, creates simple backup.
+Optional I<%opts> have the same meaning as in
+B<backup>, except that, obviously, B<type> keyword is not accepted.
+
=cut
diff --git a/t/00simple.t b/t/00simple.t
index e6d3630..bf4f71a 100644
--- a/t/00simple.t
+++ b/t/00simple.t
@@ -4,7 +4,7 @@ use strict;
use TestBackup;
use File::Backup qw(backup_simple);
-plan test => 4;
+plan test => 9;
makefile('a');
@@ -15,5 +15,23 @@ fileok('a', $name);
$name = backup_simple('a');
ok($name, 'a~');
fileok('a', $name);
-
-
+
+mkdir "subdir";
+$name = backup_simple('a', dir => 'subdir');
+ok($name, File::Spec->catfile('subdir','a~'));
+fileok('a', $name);
+
+eval {
+ backup_simple('a', dir => 'nonexisting');
+};
+ok(!!$@);
+
+$name = backup_simple('a', dir => 'nonexisting', error => \my $err);
+ok(!defined($name));
+ok(defined($err) && $err ne '');
+
+# chmod 0, 'subdir';
+# $name = backup_simple('a', dir => 'subdir', error => \$err);
+# ok(!defined($name));
+# print "$err\n";
+
diff --git a/t/01numbered.t b/t/01numbered.t
index 26a89b6..c4cd06a 100644
--- a/t/01numbered.t
+++ b/t/01numbered.t
@@ -4,7 +4,7 @@ use strict;
use TestBackup;
use File::Backup qw(backup_numbered);
-plan test => 4;
+plan test => 9;
makefile('a');
@@ -16,4 +16,17 @@ $name = backup_numbered('a');
ok($name, 'a.~2~');
fileok('a', $name);
+mkdir "subdir";
+$name = backup_numbered('a', dir => 'subdir');
+ok($name, File::Spec->catfile('subdir','a.~1~'));
+fileok('a', $name);
+
+eval {
+ backup_numbered('a', dir => 'nonexisting');
+};
+ok(!!$@);
+
+$name = backup_numbered('a', dir => 'nonexisting', error => \my $err);
+ok(!defined($name));
+ok(defined($err) && $err ne '');
diff --git a/t/02auto.t b/t/02auto.t
index 03f842a..4717020 100644
--- a/t/02auto.t
+++ b/t/02auto.t
@@ -4,7 +4,7 @@ use strict;
use TestBackup;
use File::Backup qw(backup_numbered backup_auto);
-plan test => 6;
+plan test => 16;
makefile('a');
@@ -20,3 +20,25 @@ $name = backup_auto('a');
ok($name, 'a.~2~');
fileok('a', $name);
+mkdir "subdir";
+$name = backup_auto('a', dir => 'subdir');
+ok($name, File::Spec->catfile('subdir','a~'));
+fileok('a', $name);
+
+$name = backup_auto('a', dir => 'subdir');
+ok($name, File::Spec->catfile('subdir','a~'));
+fileok('a', $name);
+
+ok(open(FH, '>', File::Spec->catfile('subdir','a.~1~')));
+$name = backup_auto('a', dir => 'subdir');
+ok($name, File::Spec->catfile('subdir','a.~2~'));
+fileok('a', $name);
+
+eval {
+ backup_auto('a', dir => 'nonexisting');
+};
+ok(!!$@);
+
+$name = backup_auto('a', dir => 'nonexisting', error => \my $err);
+ok(!defined($name));
+ok(defined($err) && $err ne '');
diff --git a/t/03backup.t b/t/03backup.t
index 136294f..2b9297d 100644
--- a/t/03backup.t
+++ b/t/03backup.t
@@ -4,7 +4,7 @@ use strict;
use TestBackup;
use File::Backup;
-plan test => 11;
+plan test => 24;
makefile('a');
@@ -30,3 +30,34 @@ fileok('a', $name);
$name = backup('a');
ok($name, 'a.~3~');
fileok('a', $name);
+
+$name = backup('a', type => BACKUP_SIMPLE);
+ok($name, 'a~');
+fileok('a', $name);
+
+mkdir "subdir";
+$name = backup('a', dir => 'subdir', type => BACKUP_SIMPLE);
+ok($name, File::Spec->catfile('subdir','a~'));
+fileok('a', $name);
+
+$name = backup('a', dir => 'subdir', type => BACKUP_AUTO);
+ok($name, File::Spec->catfile('subdir','a~'));
+fileok('a', $name);
+
+$name = backup('a', dir => 'subdir', type => BACKUP_NUMBERED);
+ok($name, File::Spec->catfile('subdir','a.~1~'));
+fileok('a', $name);
+
+$name = backup('a', dir => 'subdir', type => BACKUP_AUTO);
+ok($name, File::Spec->catfile('subdir','a.~2~'));
+fileok('a', $name);
+
+eval {
+ backup('a', dir => 'nonexisting');
+};
+ok(!!$@);
+
+$name = backup('a', dir => 'nonexisting', error => \my $err);
+ok(!defined($name));
+ok(defined($err) && $err ne '');
+

Return to:

Send suggestions and report system problems to the System administrator.