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 | 24 | ||||
-rw-r--r-- | t/01numbered.t | 15 | ||||
-rw-r--r-- | t/02auto.t | 24 | ||||
-rw-r--r-- | t/03backup.t | 33 |
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 @@ -6,2 +6,3 @@ use File::Temp; use File::Basename; +use File::Spec; use Exporter; @@ -50,3 +51,14 @@ 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)) { @@ -59,3 +71,3 @@ sub backup { } - &{$backup_func{$type}}($file); + &{$backup_func{$type}}($file, %opts); } @@ -63,6 +75,14 @@ sub backup { 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; @@ -70,9 +90,38 @@ sub backup_simple { +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 } @@ -84,6 +133,7 @@ sub backup_numbered_opt { } - } 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'; @@ -94,5 +144,10 @@ sub backup_numbered_opt { $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: $!"); } @@ -102,3 +157,3 @@ sub backup_numbered_opt { 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: $!"); } @@ -108,4 +163,5 @@ sub backup_numbered_opt { 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); } @@ -113,4 +169,5 @@ sub backup_numbered { 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); } @@ -132,2 +189,8 @@ File::Backup - create a backup of the file. + $backup_name = backup($file_name, type => BACKUP_NUMBERED, + dir => $directory, error => \my $error); + if (!$backup_name) { + warn $error; + } + =head1 DESCRIPTION @@ -145,5 +208,7 @@ called F<test.~1~>, F<test.~2~> and so on. - $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); @@ -204,2 +269,40 @@ 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 @@ -210,6 +313,8 @@ scheme. These functions must be exported explicitly. 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 @@ -217,5 +322,5 @@ Creates simple backup. 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>. @@ -224,3 +329,3 @@ Creates numbered backup. use File::Backup qw(backup_auto); - $backup_name = backup_auto($orig_name); + $backup_name = backup_auto($orig_name, %opts); @@ -229,2 +334,5 @@ 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 @@ -6,3 +6,3 @@ use File::Backup qw(backup_simple); -plan test => 4; +plan test => 9; @@ -17,3 +17,21 @@ 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 @@ -6,3 +6,3 @@ use File::Backup qw(backup_numbered); -plan test => 4; +plan test => 9; @@ -18,2 +18,15 @@ 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 ''); @@ -6,3 +6,3 @@ use File::Backup qw(backup_numbered backup_auto); -plan test => 6; +plan test => 16; @@ -22 +22,23 @@ 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 @@ -6,3 +6,3 @@ use File::Backup; -plan test => 11; +plan test => 24; @@ -32 +32,32 @@ 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 ''); + |