diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2020-01-18 17:18:42 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2020-01-19 09:45:55 +0200 |
commit | e3d9037c37a934718c9bc8fb196006fa7c002ac0 (patch) | |
tree | 29a36b983d14afe9ba89e7d4128ce00a8cec09e9 | |
download | file-backup-e3d9037c37a934718c9bc8fb196006fa7c002ac0.tar.gz file-backup-e3d9037c37a934718c9bc8fb196006fa7c002ac0.tar.bz2 |
Initial commit
-rw-r--r-- | .gitignore | 14 | ||||
-rw-r--r-- | MANIFEST.SKIP | 63 | ||||
-rw-r--r-- | Makefile.PL | 34 | ||||
-rw-r--r-- | lib/File/Backup.pm | 117 | ||||
-rw-r--r-- | t/00simple.t | 19 | ||||
-rw-r--r-- | t/01numbered.t | 19 | ||||
-rw-r--r-- | t/02auto.t | 22 | ||||
-rw-r--r-- | t/03backup.t | 32 | ||||
-rw-r--r-- | t/04envar.t | 33 | ||||
-rw-r--r-- | t/TestBackup.pm | 40 |
10 files changed, 393 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8666cce --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +*~ +\#*# +.#* +*.bak +*.tar* +.emacs.* +/tmp/ +/debug.sh +core +/MANIFEST +/MYMETA.* +/Makefile +/blib +/pm_to_blib diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..58696be --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,63 @@ +# Avoid version control files. +\bRCS\b +\bCVS\b +\bSCCS\b +,v$ +\B\.svn\b +\B\.git\b +\B\.gitignore\b +\b_darcs\b +\B\.cvsignore$ + +# Avoid VMS specific MakeMaker generated files +\bDescrip.MMS$ +\bDESCRIP.MMS$ +\bdescrip.mms$ + +# Avoid Makemaker generated and utility files. +\bMANIFEST\.bak +\bMakefile$ +\bblib/ +\bMakeMaker-\d +\bpm_to_blib\.ts$ +\bpm_to_blib$ +\bblibdirs\.ts$ # 6.18 through 6.25 generated this + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build/ +\bBuild.bat$ +\bBuild.COM$ +\bBUILD.COM$ +\bbuild.com$ + +# Avoid temp and backup files. +~$ +\.old$ +\#$ +\b\.# +\.bak$ +\.tmp$ +\.# +\.rej$ + +# Avoid OS-specific files/dirs +# Mac OSX metadata +\B\.DS_Store +# Mac OSX SMB mount metadata files +\B\._ + +# Avoid Devel::Cover and Devel::CoverX::Covered files. +\bcover_db\b +\bcovered\b + +# Avoid MYMETA files +^MYMETA\. + +^debug.sh +^tmp +^buildreq +^\.emacs\.* + +\.tar$ +\.tar\.gz$ diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..84b1f32 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,34 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; +use Module::Metadata; + +WriteMakefile( + NAME => 'File::Backup', + VERSION_FROM => 'lib/File/Backup.pm', + ABSTRACT_FROM => 'lib/File/Backup.pm', + LICENSE => 'gpl_3', + AUTHOR => 'Sergey Poznyakoff <gray@gnu.org>', + MIN_PERL_VERSION => 5.006, + PREREQ_PM => { + 'File::Temp' => 0.23 + }, + TEST_REQUIRES => { + 'File::Cmp' => 1.07 + }, + META_MERGE => { + 'meta-spec' => { version => 2 }, + resources => { + repository => { + type => 'git', + url => 'git://git.gnu.org.ua/file-backup.git', + web => 'http://git.gnu.org.ua/cgit/file-backup.git/', + }, + }, + provides => Module::Metadata->provides(version => '1.4', + dir => 'lib') + } +); + + + 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; + diff --git a/t/00simple.t b/t/00simple.t new file mode 100644 index 0000000..d3444de --- /dev/null +++ b/t/00simple.t @@ -0,0 +1,19 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use TestBackup; +use File::Backup; + +plan test => 4; + +makefile('a'); + +my $name = backup_simple('a'); +ok($name, 'a~'); +fileok('a', $name); + +$name = backup_simple('a'); +ok($name, 'a~'); +fileok('a', $name); + + diff --git a/t/01numbered.t b/t/01numbered.t new file mode 100644 index 0000000..a464684 --- /dev/null +++ b/t/01numbered.t @@ -0,0 +1,19 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use TestBackup; +use File::Backup; + +plan test => 4; + +makefile('a'); + +my $name = backup_numbered('a'); +ok($name, 'a.~1~'); +fileok('a', $name); + +$name = backup_numbered('a'); +ok($name, 'a.~2~'); +fileok('a', $name); + + diff --git a/t/02auto.t b/t/02auto.t new file mode 100644 index 0000000..354e136 --- /dev/null +++ b/t/02auto.t @@ -0,0 +1,22 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use TestBackup; +use File::Backup; + +plan test => 6; + +makefile('a'); + +my $name = backup_auto('a'); +ok($name, 'a~'); +fileok('a', $name); + +$name = backup_numbered('a'); +ok($name, 'a.~1~'); +fileok('a', $name); + +$name = backup_auto('a'); +ok($name, 'a.~2~'); +fileok('a', $name); + diff --git a/t/03backup.t b/t/03backup.t new file mode 100644 index 0000000..136294f --- /dev/null +++ b/t/03backup.t @@ -0,0 +1,32 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use TestBackup; +use File::Backup; + +plan test => 11; + +makefile('a'); + +my $name = backup('a',BACKUP_NONE); +ok(!defined($name)); + +$name = backup('a',BACKUP_SIMPLE); +ok($name, 'a~'); +fileok('a', $name); + +$name = backup('a',BACKUP_AUTO); +ok($name, 'a~'); +fileok('a', $name); + +$name = backup('a',BACKUP_NUMBERED); +ok($name, 'a.~1~'); +fileok('a', $name); + +$name = backup('a',BACKUP_AUTO); +ok($name, 'a.~2~'); +fileok('a', $name); + +$name = backup('a'); +ok($name, 'a.~3~'); +fileok('a', $name); diff --git a/t/04envar.t b/t/04envar.t new file mode 100644 index 0000000..f87f355 --- /dev/null +++ b/t/04envar.t @@ -0,0 +1,33 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use TestBackup; +use File::Backup; + +plan test => 16; + +makefile('a'); + +sub test_envar { + my ($val, $exp) = @_; + $ENV{VERSION_CONTROL} = $val; + my $name = backup('a'); + if (defined($exp)) { + ok($name,$exp); + fileok($name,'a'); + } else { + ok(!defined($name)); + } +} + +test_envar 'none'; +test_envar 'off'; +test_envar 'never', 'a~'; +test_envar 'simple', 'a~'; +test_envar 'numbered', 'a.~1~'; +test_envar 't', 'a.~2~'; +test_envar 'nil', 'a.~3~'; +test_envar 'existing', 'a.~4~'; +unlink qw(a.~1~ a.~2~ a.~3~ a.~4~); +test_envar 'existing', 'a~'; + diff --git a/t/TestBackup.pm b/t/TestBackup.pm new file mode 100644 index 0000000..0679776 --- /dev/null +++ b/t/TestBackup.pm @@ -0,0 +1,40 @@ +package TestBackup; +use File::Cmp qw(fcmp); +use File::Temp qw(tempdir); +use Exporter; +use re '/aa'; +use Carp; +use Test; + +our @ISA = qw(Test); +our @EXPORT=qw(makefile fileok plan ok); + +sub import { + my $pkg = shift; + my $workdir = tempdir(CLEANUP => 1); + chdir($workdir) or croak "can't change to $workdir: $!"; + @pattern = grep { /[\w\d]+/ } map { chr($_) } (1..127); + delete $ENV{VERSION_CONTROL}; + $pkg->export_to_level(1, @_); +} + +sub makefile { + my $file = shift; + my $size = shift // 1024; + + open(FH, '>', $file) or croak "can't create file $file (wd $workdir): $!"; + while ($size) { + my $n = @pattern; + $n = $size if $n > $size; + syswrite(FH, join('',@pattern[0..$n])) or + croak "write error creating $file: $!"; + $size -= $n; + } + close FH +} + +sub fileok { + ok(fcmp(@_)); +} + +1; |