aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2020-01-18 17:18:42 +0200
committerSergey Poznyakoff <gray@gnu.org>2020-01-19 09:45:55 +0200
commite3d9037c37a934718c9bc8fb196006fa7c002ac0 (patch)
tree29a36b983d14afe9ba89e7d4128ce00a8cec09e9
downloadfile-backup-e3d9037c37a934718c9bc8fb196006fa7c002ac0.tar.gz
file-backup-e3d9037c37a934718c9bc8fb196006fa7c002ac0.tar.bz2
Initial commit
-rw-r--r--.gitignore14
-rw-r--r--MANIFEST.SKIP63
-rw-r--r--Makefile.PL34
-rw-r--r--lib/File/Backup.pm117
-rw-r--r--t/00simple.t19
-rw-r--r--t/01numbered.t19
-rw-r--r--t/02auto.t22
-rw-r--r--t/03backup.t32
-rw-r--r--t/04envar.t33
-rw-r--r--t/TestBackup.pm40
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;

Return to:

Send suggestions and report system problems to the System administrator.