diff options
Diffstat (limited to 'lib/File/Backup.pm')
-rw-r--r-- | lib/File/Backup.pm | 117 |
1 files changed, 117 insertions, 0 deletions
diff --git a/lib/File/Backup.pm b/lib/File/Backup.pm new file mode 100644 index 0000000..8aed3bb --- /dev/null +++ b/lib/File/Backup.pm @@ -0,0 +1,117 @@ +package File::Backup; +use strict; +use warnings; +use File::Copy; +use File::Temp qw(tempdir); +use File::Basename; +use Exporter; +use re '/aa'; +use Carp; + +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 $dir = tempdir(DIR => dirname($file_name), CLEANUP => 1); + my $fh = File::Temp->new(DIR => $dir); + 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); + ++$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; + |