1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
package File::Backup;
use strict;
use warnings;
use File::Copy;
use File::Temp;
use File::Basename;
use Exporter;
use re '/aa';
use Carp;
use Errno;
our $VERSION = '1.00';
our @ISA = qw(Exporter);
our @EXPORT = qw(BACKUP_NONE
BACKUP_SINGLE
BACKUP_SIMPLE
BACKUP_NUMBERED
BACKUP_AUTO
backup
backup_simple
backup_numbered
backup_auto);
use constant {
BACKUP_NONE => 0, # No backups at all (none,off)
BACKUP_SINGLE => 1, # Always make single backups (never,simple)
BACKUP_SIMPLE => 1,
BACKUP_NUMBERED => 2, # Always make numbered backups (t,numbered)
BACKUP_AUTO => 3 # Make numbered if numbered backups exist,
# simple otherwise (nil,existing)
};
my %envtrans = (
none => BACKUP_NONE,
off => BACKUP_NONE,
never => BACKUP_SIMPLE,
simple => BACKUP_SIMPLE,
t => BACKUP_NUMBERED,
numbered => BACKUP_NUMBERED,
nil => BACKUP_AUTO,
existing => BACKUP_AUTO
);
my %backup_func = (
BACKUP_NONE() => sub {},
BACKUP_SIMPLE() => \&backup_simple,
BACKUP_NUMBERED() => \&backup_numbered,
BACKUP_AUTO() => \&backup_auto
);
sub backup {
my ($file, $type) = @_;
unless (defined($type)) {
my $v = $ENV{VERSION_CONTROL} || BACKUP_AUTO;
if (exists($envtrans{$v})) {
$type = $envtrans{$v};
} else {
$type = BACKUP_AUTO;
}
}
&{$backup_func{$type}}($file);
}
sub backup_simple {
my ($file_name) = @_;
my $backup_name = $file_name . '~';
copy($file_name, $backup_name)
or croak "failed to copy $file_name to $backup_name: $!";
return $backup_name;
}
sub backup_numbered_opt {
my ($file_name, $if_exists) = @_;
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 $num = (sort { $b <=> $a }
map {
if (/.+\.~(\d+)~$/) {
$1
} else {
()
}
} glob("$file_name.~*~"))[0];
if (!defined($num)) {
return backup_simple($file_name) if $if_exists;
$num = '1';
}
my $backup_name;
while (1) {
$backup_name = "$file_name.~$num~";
last if symlink($fh->filename, $backup_name);
unless ($!{EEXIST}) {
croak "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_name;
}
sub backup_numbered {
my ($file_name) = @_;
backup_numbered_opt($file_name, 0);
}
sub backup_auto {
my ($file_name) = @_;
backup_numbered_opt($file_name, 1);
}
1;
__END__
=head1 NAME
File::Backup - create a backup of the file.
=head1 SYNOPSIS
use File::Backup;
$backup_name = backup($file_name);
$backup_name = backup($file_name, BACKUP_NUMBERED);
=head1 DESCRIPTION
The File::Backup module provides functions for creating backup copies of
files. Normally, the name of the backup copy is created by appending a
single C<~> character to the original file name. This naming is called
I<simple backup>. Another naming scheme is I<numbered backup>. In this
scheme, the name of the backup is created by suffixing the original file
name with C<.~I<N>~>, where I<N> is a decimal number starting with 1.
In this backup naming scheme, the backup copies of file F<test> would be
called F<test.~1~>, F<test.~2~> and so on.
=head2 backup
$backup_name = backup($orig_name)
$backup_name = backup($orig_name, $scheme)
The B<backup> function is the principal interface for managing backup
copies. Its first argument specifies the name of the existing file for
which a backup copy is required. Optional second argument controls the
backup naming scheme. Its possible values are:
=over 4
=item BACKUP_NONE
Don't create backup.
=item BACKUP_SINGLE or BACKUP_SIMPLE
Create simple backup (F<I<FILE>~>).
=item BACKUP_NUMBERED
Create numbered backup (F<I<FILE>.~B<N>~>).
=item BACKUP_AUTO
Automatic selection of the naming scheme. Create numbered backup if the
file has numbered backups already. Otherwise, make simple backup.
=back
If the second argument is omitted, the function will consult the value of
the environment variable B<VERSION_CONTROL>. Its possible values are:
=over 4
=item none, off
Don't create any backups (B<BACKUP_NONE>).
=item simple, never
Create simple backups (B<BACKUP_SIMPLE>).
=item numbered, t
Create numbered backups (B<BACKUP_NUMBERED>).
=item existing, nil
Automatic selection of the naming scheme (B<BACKUP_AUTO>).
=back
If B<VERSION_CONTROL> is unset or set to any other value than those listed
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()>.
The following functions are provided for explicitly using a specific backup
naming scheme:
=head2 backup_simple
$backup_name = backup_simple($orig_name);
Creates simple backup.
=head2 backup_numbered
$backup_name = backup_numbered($orig_name);
Creates numbered backup.
=head2 backup_auto
$backup_name = backup_auto($orig_name);
Creates numbered backup if any numbered backup version already exists for
the file. Otherwise, creates simple backup.
=cut
|
