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 | |||
@@ -4,6 +4,7 @@ use warnings; | |||
4 | use File::Copy; | 4 | use File::Copy; |
5 | use File::Temp; | 5 | use File::Temp; |
6 | use File::Basename; | 6 | use File::Basename; |
7 | use File::Spec; | ||
7 | use Exporter; | 8 | use Exporter; |
8 | use re '/aa'; | 9 | use re '/aa'; |
9 | use Carp; | 10 | use Carp; |
@@ -48,7 +49,18 @@ my %backup_func = ( | |||
48 | ); | 49 | ); |
49 | 50 | ||
50 | sub backup { | 51 | sub 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 | ||
63 | sub backup_simple { | 75 | sub 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 | ||
91 | sub _backup_error { | ||
92 | my ($error, $msg) = @_; | ||
93 | if ($error) { | ||
94 | $$error = $msg; | ||
95 | return undef; | ||
96 | } | ||
97 | confess $msg; | ||
98 | } | ||
99 | |||
71 | sub backup_numbered_opt { | 100 | sub 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 | ||
108 | sub backup_numbered { | 163 | sub 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 | ||
113 | sub backup_auto { | 169 | sub 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 | ||
118 | 1; | 175 | 1; |
@@ -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 | ||
135 | The File::Backup module provides functions for creating backup copies of | 198 | 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. | |||
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 | ||
150 | The B<backup> function is the principal interface for managing backup | 215 | The B<backup> function is the principal interface for managing backup |
151 | copies. Its first argument specifies the name of the existing file for | 216 | copies. Its first argument specifies the name of the existing file for |
@@ -202,29 +267,72 @@ above, B<BACKUP_AUTO> is assumed. | |||
202 | The function returns the name of the backup file it created (C<undef> if | 267 | The function returns the name of the backup file it created (C<undef> if |
203 | called with B<BACKUP_NONE>). On error, it calls B<croak()>. | 268 | called with B<BACKUP_NONE>). On error, it calls B<croak()>. |
204 | 269 | ||
270 | When used in the third form, the B<%opts> are keyword arguments that | ||
271 | control the function behavior. The following arguments are understood: | ||
272 | |||
273 | =over 4 | ||
274 | |||
275 | =item type =E<gt> $scheme | ||
276 | |||
277 | Request a particular backup naming scheme. The following two calls are | ||
278 | equivalent: | ||
279 | |||
280 | backup($file, type => BACKUP_SIMPLE) | ||
281 | |||
282 | backup($file, BACKUP_SIMPLE) | ||
283 | |||
284 | =item dir =E<gt> $directory | ||