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 /lib | |
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.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/File/Backup.pm | 154 |
1 files changed, 131 insertions, 23 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 |