aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2020-01-19 14:02:26 +0200
committerSergey Poznyakoff <gray@gnu.org>2020-01-19 14:03:55 +0200
commit4e1f50027c7d6fc59d47d932a2a37860e928ebb5 (patch)
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.
-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;
4use File::Copy; 4use File::Copy;
5use File::Temp; 5use File::Temp;
6use File::Basename; 6use File::Basename;
7use File::Spec;
7use Exporter; 8use Exporter;
8use re '/aa'; 9use re '/aa';
9use Carp; 10use Carp;
@@ -48,7 +49,18 @@ my %backup_func = (
48); 49);
49 50
50sub backup { 51sub backup {
51 my ($file, $type) = @_; 52 my $file = shift;
53
54 my ($type, %opts);
55 if (@_ == 1) {
56 $type = shift;
57 } elsif (@_ % 2 == 0) {
58 %opts = @_;
59 $type = delete $opts{type};
60 } else {
61 croak "wrong number of arguments";
62 }
63
52 unless (defined($type)) { 64 unless (defined($type)) {
53 my $v = $ENV{VERSION_CONTROL} || BACKUP_AUTO; 65 my $v = $ENV{VERSION_CONTROL} || BACKUP_AUTO;
54 if (exists($envtrans{$v})) { 66 if (exists($envtrans{$v})) {
@@ -57,24 +69,61 @@ sub backup {
57 $type = BACKUP_AUTO; 69 $type = BACKUP_AUTO;
58 } 70 }
59 } 71 }
60 &{$backup_func{$type}}($file); 72 &{$backup_func{$type}}($file, %opts);
61} 73}
62 74
63sub backup_simple { 75sub backup_simple {
64 my ($file_name) = @_; 76 my $file_name = shift;
77 local %_ = @_;
78 my $error = delete $_{error};
79 my $dir = delete $_{dir};
80 croak "unrecognized keyword arguments" if keys %_;
65 my $backup_name = $file_name . '~'; 81 my $backup_name = $file_name . '~';
82 if ($dir) {
83 $backup_name = File::Spec->catfile($dir, $backup_name);
84 }
66 copy($file_name, $backup_name) 85 copy($file_name, $backup_name)
67 or croak "failed to copy $file_name to $backup_name: $!"; 86 or return _backup_error($error,
87 "failed to copy $file_name to $backup_name: $!");
68 return $backup_name; 88 return $backup_name;
69} 89}
70 90
91sub _backup_error {
92 my ($error, $msg) = @_;
93 if ($error) {
94 $$error = $msg;
95 return undef;
96 }
97 confess $msg;
98}
99
71sub backup_numbered_opt { 100sub backup_numbered_opt {
72 my ($file_name, $if_exists) = @_; 101 my $file_name = shift;
102
103 my ($if_exists, $error, $dir);
104 if (@_ == 1) {
105 $if_exists = shift;
106 } elsif (@_ % 2 == 0) {
107 local %_ = @_;
108 $if_exists = delete $_{if_exists};
109 $error = delete $_{error};
110 $dir = delete $_{dir};
111 croak "unrecognized keyword arguments" if keys %_;
112 } else {
113 croak "wrong number of arguments";
114 }
115
116 my $fh = eval { File::Temp->new(DIR => $dir || dirname($file_name)) };
117 if ($@) {
118 return _backup_error($error, $@);
119 }
73 120
74 my $fh = File::Temp->new(DIR => dirname($file_name)); 121 copy($file_name, $fh)
75 copy($file_name, $fh) or 122 or return _backup_error($error,
76 croak "failed to make a temporary copy of $file_name: $!"; 123 "failed to make a temporary copy of $file_name: $!");
77 124
125 my $pat = $dir ? File::Spec->catfile($dir, "$file_name.~*~")
126 : "$file_name.~*~";
78 my $num = (sort { $b <=> $a } 127 my $num = (sort { $b <=> $a }
79 map { 128 map {
80 if (/.+\.~(\d+)~$/) { 129 if (/.+\.~(\d+)~$/) {
@@ -82,37 +131,45 @@ sub backup_numbered_opt {
82 } else { 131 } else {
83 () 132 ()
84 } 133 }
85 } glob("$file_name.~*~"))[0]; 134 } glob($pat))[0];
86 135
87 if (!defined($num)) { 136 if (!defined($num)) {
88 return backup_simple($file_name) if $if_exists; 137 return backup_simple($file_name, error => $error, dir => $dir)
138 if $if_exists;
89 $num = '1'; 139 $num = '1';
90 } 140 }
91 141
92 my $backup_name; 142 my $backup_name;
93 while (1) { 143 while (1) {
94 $backup_name = "$file_name.~$num~"; 144 $backup_name = "$file_name.~$num~";
145 if ($dir) {
146 $backup_name = File::Spec->catfile($dir, $backup_name);
147 }
95 last if symlink($fh->filename, $backup_name); 148 last if symlink($fh->filename, $backup_name);
96 unless ($!{EEXIST}) { 149 unless ($!{EEXIST}) {
97 croak "can't link ".$fh->filename." to $backup_name: $!"; 150 return _backup_error("can't link "
151 . $fh->filename .
152 " to $backup_name: $!");
98 } 153 }
99 ++$num; 154 ++$num;
100 } 155 }
101 156
102 unless (rename($fh->filename, $backup_name)) { 157 unless (rename($fh->filename, $backup_name)) {
103 croak "can't rename temporary file to $backup_name: $!"; 158 return _backup_error("can't rename temporary file to $backup_name: $!");
104 } 159 }
105 return $backup_name; 160 return $backup_name;
106} 161}
107 162
108sub backup_numbered { 163sub backup_numbered {
109 my ($file_name) = @_; 164 my ($file_name, %opts) = @_;
110 backup_numbered_opt($file_name, 0); 165 $opts{if_exists} = 0;
166 backup_numbered_opt($file_name, %opts);
111} 167}
112 168
113sub backup_auto { 169sub backup_auto {
114 my ($file_name) = @_; 170 my ($file_name, %opts) = @_;
115 backup_numbered_opt($file_name, 1); 171 $opts{if_exists} = 1;
172 backup_numbered_opt($file_name, %opts);
116} 173}
117 174
1181; 1751;
@@ -130,6 +187,12 @@ File::Backup - create a backup of the file.
130 187
131 $backup_name = backup($file_name, BACKUP_NUMBERED); 188 $backup_name = backup($file_name, BACKUP_NUMBERED);
132 189
190 $backup_name = backup($file_name, type => BACKUP_NUMBERED,
191 dir => $directory, error => \my $error);
192 if (!$backup_name) {
193 warn $error;
194 }
195
133=head1 DESCRIPTION 196=head1 DESCRIPTION
134 197
135The File::Backup module provides functions for creating backup copies of 198The File::Backup module provides functions for creating backup copies of
@@ -143,9 +206,11 @@ called F<test.~1~>, F<test.~2~> and so on.
143 206
144=head2 backup 207=head2 backup
145 208
146 $backup_name = backup($orig_name) 209 $backup_name = backup($orig_name);
147 210
148 $backup_name = backup($orig_name, $scheme) 211 $backup_name = backup($orig_name, $scheme);
212
213 $backup_name = backup($orig_name, %opts);
149 214
150The B<backup> function is the principal interface for managing backup 215The B<backup> function is the principal interface for managing backup
151copies. Its first argument specifies the name of the existing file for 216copies. Its first argument specifies the name of the existing file for
@@ -202,29 +267,72 @@ above, B<BACKUP_AUTO> is assumed.
202The function returns the name of the backup file it created (C<undef> if 267The function returns the name of the backup file it created (C<undef> if
203called with B<BACKUP_NONE>). On error, it calls B<croak()>. 268called with B<BACKUP_NONE>). On error, it calls B<croak()>.
204 269
270When used in the third form, the B<%opts> are keyword arguments that
271control the function behavior. The following arguments are understood:
272
273=over 4
274
275=item type =E<gt> $scheme
276
277Request a particular backup naming scheme. The following two calls are
278equivalent:
279
280 backup($file, type => BACKUP_SIMPLE)
281
282 backup($file, BACKUP_SIMPLE)
283
284=item dir =E<gt> $directory