diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2020-01-19 14:02:26 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2020-01-19 14:03:55 +0200 |
commit | 4e1f50027c7d6fc59d47d932a2a37860e928ebb5 (patch) | |
tree | 022335ab7b86361950ae133de493fc76d33b05b0 | |
parent | fdea256ea75e0ca072915d7522564052a9f683f0 (diff) | |
download | file-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.
-rw-r--r-- | lib/File/Backup.pm | 154 | ||||
-rw-r--r-- | t/00simple.t | 20 | ||||
-rw-r--r-- | t/01numbered.t | 15 | ||||
-rw-r--r-- | t/02auto.t | 24 | ||||
-rw-r--r-- | t/03backup.t | 33 |
5 files changed, 219 insertions, 27 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 = File::Temp->new(DIR => dirname($file_name)); - copy($file_name, $fh) or - croak "failed to make a temporary copy of $file_name: $!"; + my $fh = eval { File::Temp->new(DIR => $dir || dirname($file_name)) }; + if ($@) { + return _backup_error($error, $@); + } + + 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. Optional I<%opts> have the same meaning as in +B<backup>, except that, obviously, B<type> keyword is not accepted. -Creates simple backup. =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'); @@ -16,4 +16,22 @@ $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 ''); @@ -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 ''); + |