tStart rewriting in a cleaner fashion - lumia - Archive checksum manager
HTML git clone git://lumidify.org/git/lumia.git
DIR Log
DIR Files
DIR Refs
DIR README
DIR LICENSE
---
DIR commit f60d1fa300a9def9bed31e38e9c0025676705efd
DIR parent 15d5db13de4e74e63ecf44a0d687712124a6bca8
HTML Author: lumidify <nobody@lumidify.org>
Date: Mon, 23 Mar 2020 08:40:19 +0100
Start rewriting in a cleaner fashion
Diffstat:
M lumia.pl | 881 +++++++++++++------------------
1 file changed, 378 insertions(+), 503 deletions(-)
---
DIR diff --git a/lumia.pl b/lumia.pl
t@@ -34,74 +34,95 @@ use Data::Dumper;
use Scalar::Util qw(looks_like_number);
use Getopt::Long;
-sub make_dir_iter {
- my @queue = @_;
+sub escape_filename {
+ my $file = shift;
+ $file =~ s/\\/\\\\/g;
+ $file =~ s/"/\\"/g;
+ return $file;
+}
+sub make_file_iter {
+ my ($file_func, $dir_func, @queue) = @_;
return sub {
while (@queue) {
my $file = shift @queue;
- if (!-d $file) {
- warn "WARNING: \"$file\" is not directory!";
- next;
- }
- my $dh;
- if (!opendir $dh, $file) {
- warn "WARNING: Unable to open directory \"$file\"!";
- next;
+ if (-d $file) {
+ my $new_files = $dir_func->($file);
+ next if !defined $new_files;
+ push @queue, @$new_files;
}
- my @newdirs = grep {-d "$file/$_" && $_ ne "." && $_ ne ".."} readdir $dh;
- push @queue, map "$file/$_", @newdirs;
- closedir $dh;
- return $file;
+ return $file if $file_func->($file);
}
return;
};
}
+sub make_file_iter_basic {
+ my ($file_func, @files) = @_;
+ make_file_iter $file_func, sub {
+ my $dh;
+ if (!opendir $dh, $_[0]) {
+ warn "WARNING: Unable to open directory \"$_[0]\"!";
+ return [];
+ }
+ my @new_files = map "$_[0]/$_", grep {$_ ne "." && $_ ne ".."} readdir $dh;
+ closedir $dh;
+ return \@new_files;
+ }, @files;
+}
+
+sub make_dir_iter {
+ make_file_iter_basic sub {-d $_[0]}, @_;
+}
+
+sub make_lumia_iter {
+ make_file_iter sub {1}, sub {
+ my $path = "$_[0]/.lumidify_archive_dirs";
+ return [] if !-f $path;
+ my $dirs = read_file($path);
+ return if !defined $dirs;
+ my @new_dirs;
+ foreach my $dir (keys %$dirs) {
+ my $dir_path = "$_[0]/$dir";
+ if (!-d $dir_path) {
+ warn "ERROR: Directory \"$dir_path\" does not exist or is not directory.\n");
+ } else {
+ push @new_dirs, $dir_path;
+ }
+ }
+ return \@new_dirs;
+ }, @_;
+}
+
my $CKSUM_CMD = 'cksum -q';
-my $CKSUM_CHECK_CMD = 'cksum -c';
-my $CKSUM_CHECK_SINGLE_CMD = 'cksum -q';
+my %SPECIAL_FILES = (
+ ".lumidify_archive_cksums" => 1,
+ ".lumidify_archive_cksums.cksum" => 1,
+ ".lumidify_archive_ignore" => 1,
+ ".lumidify_archive_dirs" => 1
+);
sub clean_files {
- my @files = (
- ".lumidify_archive_cksums",
- ".lumidify_archive_cksums.cksum",
- ".lumidify_archive_ignore",
- ".lumidify_archive_dirs"
- );
- for my $file (@files) {
- if (-e $file) {
- my $dir = getcwd();
- unlink($file, {safe => 1}) or return "ERROR: can't remove \"$dir/$file\": $!";
- print("Deleted \"$dir/$file\"\n");
- }
- }
- opendir(my $dh, ".") or die("ERROR: Unable to list files in \"" . getcwd() . "\"\n");
- my @dirs;
- my $file;
- while ($file = readdir($dh)) {
- next if ($file =~ /\A\.\.?\z/);
- # Just so these files aren't all left open while recursing
- if (-d $file) {
- push(@dirs, $file);
- }
- }
- closedir($dh);
- my $dir = getcwd();
- foreach (@dirs) {
- chdir($_);
- clean_files();
- chdir($dir);
+ my $dir = shift;
+ my $match_lumia_files = sub {
+ exists $SPECIAL_FILES{basename $_[0]};
+ };
+ my $iter = make_file_iter $match_lumia_files, $dir;
+ while (my $file = $iter->()) {
+ if (!unlink $file) {
+ warn "WARNING: Unable to remove file \"$file\"!";
+ } else {
+ print "Deleted \"$file\"";
+ }
}
}
sub read_file {
my ($file, $is_cksums_file) = @_;
- my $path = catfile(getcwd(), $file);
my %cksums;
my $fh;
if (!open($fh, "<", $file)) {
- print(STDERR "ERROR: unable to open file \"$path\": $!\n");
- return;
+ warn "ERROR: unable to open file \"$file\": $!\n";
+ return undef;
}
my $in_fn = 0;
my $cur_cksum;
t@@ -112,7 +133,7 @@ sub read_file {
if ($is_cksums_file && !$in_fn) {
my @fields = split(/ /, $_, 3);
if ($#fields != 2) {
- print(STDERR "ERROR: malformed line \"$_\" in file \"$path\"\n");
+ warn "ERROR: Malformed line \"$_\" in file \"$file\"\n");
next;
}
$cur_cksum = join(" ", @fields[0,1]);
t@@ -142,375 +163,236 @@ sub read_file {
}
}
if ($in_fn) {
- print(STDERR "ERROR: unterminated filename in file \"$path\"\n");
+ warn "ERROR: Unterminated filename in file \"$path\"\n";
+ return undef;
}
return \%cksums;
}
+sub read_cksums {
+ my $dir = shift;
+ my $file_cksums = read_file "$dir/.lumidify_archive_cksums", 1;
+ my $dir_list = read_file "$dir/.lumidify_archive_dirs";
+ return undef if !defined $file_cksums || !defined $dir_list;
+ my %cksums = (%$file_cksums, %$dir_list);
+ return \%cksums;
+}
+
+sub get_cksum {
+ my $path = shift;
+ my $path_esc = shell_quote $path;
+ $cksum_output = `$CKSUM_CMD -- $path_esc 2>&1`;
+ if ($?) {
+ warn "ERROR getting cksum for file \"$path\":\n$cksum_output\n";
+ return undef;
+ }
+ chomp $cksum_output;
+ return $cksum_output;
+}
+
# This would be much cleaner with cksums's -c option, but that
# doesn't seem to work with files beginning with whitespace
sub check_cksums {
- my $cksum_file = shift;
- my $cksums = read_file($cksum_file, 1);
+ my ($dir, $cksum_file) = @_;
+ my $cksums = read_file "$dir/$cksum_file", 1;
+ return if !defined $cksums;
foreach my $file (keys %$cksums) {
- my $file_esc = shell_quote($file);
- my $output = `$CKSUM_CHECK_SINGLE_CMD -- $file_esc 2>&1`;
- my $path = catfile(getcwd(), $file);
- if ($?) {
- print(STDERR "ERROR getting cksum for file \"$path\":\n$output\n");
- next;
- }
- chomp($output);
+ my $path = catfile($dir, $file);
+ my $output = get_cksum $path;
+ next if !defined $output;
print(($output eq $cksums->{$file} ? "OK" : "FAILED") . " $path\n");
}
- return;
- my $fullpath = catfile(getcwd(), $cksum_file);
- my $fh;
- if (!open($fh, "<", $cksum_file)) {
- print("ERROR: unable to open cksum file \"$fullpath\": $!\n");
- return;
- }
- foreach (<$fh>) {
- chomp;
- next if !$_;
- my @fields = split(/ /, $_, 3);
- if ($#fields != 2) {
- print("ERROR: malformed line \"$_\" in file \"$fullpath\"\n");
- next;
- }
- my $cksum = join(" ", @fields[0,1]);
- my $file = shell_quote($fields[2]);
- # '--' needed so it works on files with leading '-'
- my $output = `$CKSUM_CHECK_SINGLE_CMD -- $file`;
- my $path = catfile(getcwd(), $fields[2]);
- if ($?) {
- print("ERROR getting cksum for file \"$path\":\n$output\n");
- next;
- }
- chomp($output);
- print(($output eq $cksum ? "OK" : "FAILED") . " $path\n");
- }
- close($fh);
}
sub check_files {
- check_cksums(".lumidify_archive_cksums.cksum");
- check_cksums(".lumidify_archive_cksums");
- #my $output = `$CKSUM_CHECK_CMD .lumidify_archive_cksums.cksum`;
- #if ($?) {
- # print("ERROR in directory \"" . getcwd() . "\"\n");
- #}
- # It would be better to do this properly with cksum printing its output
- # directly, but I couldn't get system() to work with quitting if SIGINT
- # is received (yes, I followed the instructions in perldoc -f system)
- #print($output);
- #if (-s ".lumidify_archive_cksums") {
- # $output = `$CKSUM_CHECK_CMD .lumidify_archive_cksums`;
- # if ($?) {
- # print("ERROR in directory \"" . getcwd() . "\"\n");
- # }
- # print($output);
- #}
- return if (!-f ".lumidify_archive_dirs");
- my $dirs = read_file(".lumidify_archive_dirs");
- foreach my $dir (keys %$dirs) {
- my $cwd = getcwd();
- if (!-d $dir) {
- print("ERROR: directory \"$cwd/$dir\" does not exist anymore.\n");
- next;
- }
- chdir($dir);
- check_files();
- chdir($cwd);
- }
- return;
- open(my $fh, "<", ".lumidify_archive_dirs") or die("ERROR: Unable to open \"" . getcwd() . "/.lumidify_archive_dirs\"\n");
- my @dirs;
- foreach (<$fh>) {
- chomp;
- next if (!$_);
- # Just so these files aren't all left open while recursing
- push(@dirs, $_);
- }
- close($fh);
- foreach (@dirs) {
- my $dir = getcwd();
- if (!-d $_) {
- print("ERROR: directory \"$dir/$_\" does not exist anymore.\n");
- next;
- }
- chdir($_);
- check_files();
- chdir($dir);
+ my $top_dir = shift;
+ my $iter = make_lumia_iter $dir;
+ while (my $dir = $iter->()) {
+ check_cksums $dir, ".lumidify_archive_cksums.cksum";
+ check_cksums $dir, ".lumidify_archive_cksums";
}
}
-sub check_new_files_recurse {
- my $dir = shift;
- my $cur_hash = shift;
- my $cur_cksum_hash = shift;
- #my %ignore;
- my $ignore = {};
- if (-f catfile($dir, '.lumidify_archive_ignore')) {
- $ignore = read_file(catfile($dir, ".lumidify_archive_ignore"));
- }
-=pod
- open(my $fh, "<", catfile($dir, '.lumidify_archive_ignore')) or die("Can't open $dir/.lumidify_archive_ignore: $!\n");
- foreach (<$fh>) {
- chomp;
- $ignore{$_} = undef;
- }
- close($fh);
- }
-=cut
- opendir(my $dh, $dir) or die("Can't open $dir: $!\n");
- my $file;
- my $fullpath;
- while ($file = readdir($dh)) {
- next if ($file =~ /\A\.\.?\z/);
- next if (exists($ignore->{$file}));
- next if ($file eq '.lumidify_archive_cksums' ||
- $file eq '.lumidify_archive_cksums.cksum' ||
- $file eq '.lumidify_archive_dirs' ||
- $file eq '.lumidify_archive_ignore');
- $fullpath = catfile($dir, $file);
- if (-d $fullpath) {
- $cur_hash->{$file} = {};
- if (!defined($cur_cksum_hash) || !exists($cur_cksum_hash->{$file})) {
- check_new_files_recurse($fullpath, $cur_hash->{$file}, undef);
- } else {
- check_new_files_recurse($fullpath, $cur_hash->{$file}, $cur_cksum_hash->{$file});
- }
- } else {
- if (!defined($cur_cksum_hash) || !exists($cur_cksum_hash->{$file})) {
- $cur_hash->{$file} = undef;
- }
- }
- }
- closedir($dh);
+sub write_special_cksums {
+ my ($dir, @files) = @_;
+ my $cksum_file = "$dir/.lumidify_archive_cksums.cksum";
+ my $cksums = read_file $cksum_file, 1;
+ foreach my $file (@files) {
+ my $cksum_output = get_cksum "$dir/$file";
+ next if (!defined $cksum_output);
+ $cksums->{$file} = $cksum_output;
+ }
+ write_file($cksum_file, $cksums, 1);
}
sub check_new_files {
- my $dir = shift;
- my $cksum_tree = shift;
- my %new_hash;
- check_new_files_recurse($dir, \%new_hash, $cksum_tree);
- return \%new_hash;
+ my ($dir, $file_func, $before_dir_func, $after_dir_func) = @_;
+ my $iter = make_file_iter sub {-d $_[0]}, sub {
+ my $dh;
+ if (!opendir $dh, $_[0]) {
+ warn "ERROR: Unable to open directory \"$_[0]\"!";
+ return undef;
+ }
+ my $ignore = read_file "$_[0]/.lumidify_archive_ignore" // {};
+ my $lumia_dirs = read_file "$_[0]/.lumidify_archive_dirs" // {};
+ my $lumia_files = read_file "$_[0]/.lumidify_archive_cksums", 1 // {};
+ my @dirs;
+ my $found = 0;
+ while (my $file = readdir $dh) {
+ next if $file eq "." || $file eq "..";
+ next if exists $ignore->{$file} || exists $SPECIAL_FILES{$file};
+ if (!exists $lumia_dirs->{$file} && !exists $lumia_files->{$file}) {
+ if (!found && defined $before_dir_func) {
+ $before_dir_func->($_[0]);
+ }
+ if (defined $file_func) {
+ $file_func->($_[0], $file);
+ } else {
+ print "$_[0]/$file";
+ }
+ $found = 1;
+ }
+ push @dirs, "$_[0]/$file" if -d "$_[0]/$file";
+ }
+ closedir $fh;
+ if (found && defined $after_dir_func) {
+ $after_dir_func->($_[0]);
+ }
+ return \@dirs;
+ }, $dir;
+ # Is this a horrible hack? I dunno, but it sure is sweet...
+ while ($iter->()) {}
}
-sub add_new_files_recurse {
- my $dir = shift;
- my $cur_hash = shift;
- my $cur_cksum_hash = shift;
- my $fullpath;
- my $cksum_output;
- foreach my $file (keys(%$cur_hash)) {
- $fullpath = catfile($dir, $file);
+sub check_add_new_files {
+ my $top_dir = shift;
+ my $changed_dirs = 0;
+ my $changed_files = 0;
+ check_new_files $top_dir, sub {
+ my ($dir, $file) = @_;
+ my $fullpath = "$dir/$file";
if (-d $fullpath) {
- if (!exists($cur_cksum_hash->{$file})) {
- $cur_cksum_hash->{$file} = {};
+ my $dir_file = "$dir/.lumidify_archive_dirs";
+ my $fh;
+ if (!open $fh, ">>", $dir_file) {
+ warn "ERROR: Unable to append to file \"$dir_file\"!";
+ return;
}
- add_new_files_recurse($fullpath, $cur_hash->{$file}, $cur_cksum_hash->{$file});
+ print $fh, "\"" . escape_filename $file . "\"\n";
+ close $fh;
+ $changed_dirs = 1;
} else {
- my $path_esc = shell_quote($fullpath);
- $cksum_output = `$CKSUM_CMD -- $path_esc`;
- chomp($cksum_output);
- # TODO: check for error
- $cur_cksum_hash->{$file} = $cksum_output;
- print("Added checksum: $cksum_output $fullpath\n");
+ my $cksum_output = get_cksum $fullpath;
+ return if !defined $cksum_output;
+ my $cksum_file = "$dir/.lumidify_archive_cksums";
+ my $fh;
+ if (!open $fh, ">>", $cksum_file) {
+ warn "ERROR: Unable to append to file \"$cksum_file\"!";
+ return;
+ }
+ print $fh, $cksum_output . " \"" . escape_filename $file . "\"\n";
+ close $fh;
+ $changed_files = 1;
}
- }
-}
-
-sub add_new_files {
- my $dir = shift;
- my $new_files = shift;
- my $cksum_tree = shift;
- add_new_files_recurse($dir, $new_files, $cksum_tree);
+ }, sub {check_cksums $_[0], ".lumidify_archive_cksums.cksum";}, sub {
+ if ($changed_dirs) {
+ write_special_cksums $_[0], ".lumidify_archive_dirs";
+ }
+ if ($changed_files) {
+ write_special_cksums $_[0], ".lumidify_archive_files";
+ }
+ };
}
-sub check_add_new_files {
+sub check_old_files {
my $dir = shift;
- my $cksum_tree = shift;
- my $new_files = check_new_files($dir, $cksum_tree);
- add_new_files($dir, $new_files, $cksum_tree);
- write_cksums($dir, $cksum_tree);
-}
-
-sub read_cksums_old {
- my ($cksums, $dir, $recurse) = @_;
- my $cksums_file = catfile($dir, '.lumidify_archive_cksums');
- if (!-f $cksums_file) {
- die("No cksum file '.lumidify_archive_cksums' in directory $dir\n");
- }
- open(my $fh, "<", $cksums_file) or die("Can't open $cksums_file: $!\n");
- foreach (<$fh>) {
- chomp;
- next if (!$_);
- my @fields = split(/ /, $_, 3);
- if ($#fields != 2 || !looks_like_number($fields[0])) {
- print("ERROR: Malformed line in $cksums_file:\n$_\n");
- next;
- }
- $cksums->{$fields[2]} = $fields[0] . " " . $fields[1];
- }
- close($fh);
- my $dirs_file = catfile($dir, '.lumidify_archive_dirs');
- return if (!-f $dirs_file);
- open($fh, "<", $dirs_file) or die("Can't open $dirs_file: $!\n");
- foreach (<$fh>) {
- chomp;
- next if (!$_);
- my $fulldir = catdir($dir, $_);
- if (!-d $fulldir) {
- print(STDERR "WARNING: Directory \"$fulldir\" mentioned in \"$dirs_file\" does not exist!\n");
- }
- $cksums->{$_} = {};
- if ($recurse) {
- read_cksums_old($cksums->{$_}, $fulldir, 1);
+ my $iter = make_lumia_iter $dir;
+ while (my $file = $iter->()) {
+ if (!-e $file) {
+ warn "Nonexistent file or directory: \"$file\"!";
}
}
- close($fh);
}
-sub read_cksums {
- my ($cksums, $dir, $recurse) = @_;
- my $cksums_file = catfile($dir, '.lumidify_archive_cksums');
- if (!-f $cksums_file) {
- die("No cksum file '.lumidify_archive_cksums' in directory $dir\n");
- }
- my $tmp_cksums = read_file($cksums_file, 1);
- foreach (keys %$tmp_cksums) {
- $cksums->{$_} = $tmp_cksums->{$_};
- }
- #$cksums->{keys %$tmp_cksums} = @{$tmp_cksums->{keys %$tmp_cksums}};
-=pod
- open(my $fh, "<", $cksums_file) or die("Can't open $cksums_file: $!\n");
- foreach (<$fh>) {
- chomp;
- next if (!$_);
- my @fields = split(/ /, $_, 3);
- if ($#fields != 2) {
- print("ERROR: Malformed line in $cksums_file:\n$_\n");
- next;
- }
- $cksums->{$fields[2]} = $fields[0] . " " . $fields[1];
- }
- close($fh);
-=cut
- my $dirs_file = catfile($dir, '.lumidify_archive_dirs');
- return if (!-f $dirs_file);
- my $dirs = read_file($dirs_file);
- foreach (keys %$dirs) {
- my $fulldir = catdir($dir, $_);
- if (!-d $fulldir) {
- print(STDERR "WARNING: Directory \"$fulldir\" mentioned in \"$dirs_file\" does not exist!\n");
- }
- $cksums->{$_} = {};
- if ($recurse) {
- read_cksums($cksums->{$_}, $fulldir, 1);
- }
+sub write_file {
+ my ($path, $contents, $is_cksum_file) = @_;
+ my $fh;
+ if (!open $fh, ">", $path) {
+ warn "ERROR: Unable to open \"$path\" for writing!";
+ return;
}
-=pod
- open($fh, "<", $dirs_file) or die("Can't open $dirs_file: $!\n");
- foreach (<$fh>) {
- chomp;
- next if (!$_);
- my $fulldir = catdir($dir, $_);
- if (!-d $fulldir) {
- print(STDERR "WARNING: Directory \"$fulldir\" mentioned in \"$dirs_file\" does not exist!\n");
- }
- $cksums->{$_} = {};
- if ($recurse) {
- read_cksums($cksums->{$_}, $fulldir, 1);
+ foreach my $filename (keys %$contents) {
+ if ($is_cksum_file) {
+ print $fh "$contents->{$filename} ";
}
+ print $fh "\"" . escape_filename $filename . "\"\n";
}
- close($fh);
-=cut
+ close $fh;
}
-sub init_cksums_old {
- my $dir = shift;
- # avoid catfile turning it into an absolute path if $dir is an empty string
- if (!$dir) {
- $dir = ".";
+sub write_cksums {
+ my ($dir, $contents, $files_modified, $dirs_modified) = @_;
+ # No, this isn't efficient...
+ if ($files_modified) {
+ my %file_cksums = map {$_ => $contents->{$_}}, grep {defined $contents->{$_}}, keys %$contents;
+ write_file "$dir/.lumidify_archive_cksums", \%file_cksums, 1;
+ write_special_cksums $dir, ".lumidify_archive_files";
+ }
+ if ($dirs_modified) {
+ my %dir_cksums = map {$_ => undef}, grep {!defined $contents->{$_}}, keys %$contents;
+ write_file "$dir/.lumidify_archive_dirs", \%file_cksums;
+ write_special_cksums $dir, ".lumidify_archive_dirs";
}
- my %cksums;
- read_cksums_old(\%cksums, $dir, 1);
- return \%cksums;
}
-sub init_cksums {
+sub remove_old_files {
my $dir = shift;
- # avoid catfile turning it into an absolute path if $dir is an empty string
- if (!$dir) {
- $dir = ".";
+ my $iter = make_lumia_iter $dir;
+ while (my $file = $iter->()) {
+ if (!-e $file) {
+ my $dir = dirname $file;
+ my $filename = basename $file;
+ my $lumia_dirs = read_file "$dir/.lumidify_archive_dirs";
+ if (defined $lumia_dirs && exists $lumia_dirs->{$filename}) {
+ delete $lumia_dirs->{$filename};
+ write_file $dir, $lumia_dirs;
+ print "Removed \"$file\" from \"$dir/.lumidify_archive_dirs\"\n";
+ write_special_cksums $dir, ".lumidify_archive_dirs";
+ } else {
+ my $lumia_files = read_file "$dir/.lumidify_archive_cksums", 1;
+ next if !defined $lumia_files;
+ delete $lumia_files->{$filename};
+ write_file $dir, $lumia_files, 1;
+ print "Removed \"$file\" from \"$dir/.lumidify_archive_files\"\n";
+ write_special_cksums $dir, ".lumidify_archive_cksums";
+ }
+ }
}
- my %cksums;
- read_cksums(\%cksums, $dir, 1);
- return \%cksums;
}
-# TODO: possibly sort files before dumping in files?
-sub write_cksums {
- my ($dir, $cur_cksum_hash, $recurse, $create_dirs) = @_;
- # FIXME: error checking
- if ($create_dirs) {
- make_path($dir);
- }
- my $cksums_path = catfile($dir, ".lumidify_archive_cksums");
- my $dirs_path = catfile($dir, ".lumidify_archive_dirs");
- open(my $cksumsfh, ">", $cksums_path) or die("Can't open \"$cksums_path\" for writing: $!\n");
- open(my $dirsfh, ">", $dirs_path) or die("Can't open \"$dirs_path\" for writing: $!\n");
- foreach my $file (keys %$cur_cksum_hash) {
- my $file_esc = $file;
- $file_esc =~ s/\\/\\\\/g;
- $file_esc =~ s/"/\\"/g;
- if (ref($cur_cksum_hash->{$file}) eq "HASH") {
- print($dirsfh "\"$file_esc\"\n");
- } else {
- print($cksumsfh "$cur_cksum_hash->{$file} \"$file_esc\"\n");
- }
- }
- close($cksumsfh);
- close($dirsfh);
-
- open(my $fh, ">", "$cksums_path.cksum") or die("Cannot open $cksums_path.cksum for writing\n");
- my $cksums_path_esc = shell_quote($cksums_path);
- my $dirs_path_esc = shell_quote($dirs_path);
- my $cksums_cksum = `$CKSUM_CMD $cksums_path_esc`;
- my $dirs_cksum = `$CKSUM_CMD $dirs_path_esc`;
- chomp($cksums_cksum);
- chomp($dirs_cksum);
- print($fh "$cksums_cksum \".lumidify_archive_cksums\"\n");
- print($fh "$dirs_cksum \".lumidify_archive_dirs\"\n");
- if (-f catfile($dir, '.lumidify_archive_ignore')) {
- my $ignore_path_esc = shell_quote(catfile($dir, '.lumidify_archive_ignore'));
- my $ignore_cksum = `$CKSUM_CMD $ignore_path_esc`;
- chomp $ignore_cksum;
- print($fh "$ignore_cksum \".lumidify_archive_ignore\"\n");
- }
- close($fh);
-
- # For e.g. moving, we don't want to read and write all cksums since
- # everything below the level being moved stays the same
- return if (!$recurse);
- # Use second pass for this so the files don't all stay open
- foreach my $file (keys %$cur_cksum_hash) {
- if (ref($cur_cksum_hash->{$file}) eq "HASH") {
- write_cksums(catdir($dir, $file), $cur_cksum_hash->{$file}, 1, $create_dirs);
+sub sort_by_dir {
+ my %sorted_files;
+ foreach my $file (@_) {
+ if (!-e $file) {
+ warn "ERROR: Source file \"$file\" doesn't exist.\n";
+ next;
+ }
+ my $dir = dirname($file);
+ if (!exists($sorted_files{$dir})) {
+ $sorted_files{$dir} = [];
}
+ push(@{$sorted_files{$dir}}, basename($file));
}
+ return \%sorted_files;
}
# $src: list of source paths
# $dst: destination directory or file (in latter case only one src is allowed)
sub copy_files {
- my $src = shift;
- my $dst = shift;
+ my ($src, $dst) = @_;
my $dst_dir = $dst;
if (!-d $dst) {
- $dst_dir = dirname($dst);
+ $dst_dir = dirname $dst;
}
my $diff_name = 0;
if (!-d $dst && !-d $src->[0]) {
t@@ -520,44 +402,44 @@ sub copy_files {
$diff_name = 1;
}
if (system("cp", "-aiv", @$src, $dst)) {
- die("ERROR while copying files\n");
- }
- # Separate files by current dir so the cksum and dir files only need to be opened once
- my %src_files;
- foreach my $src_file (@$src) {
- my $dir = dirname($src_file);
- if (!exists($src_files{$dir})) {
- $src_files{$dir} = [];
- }
- push(@{$src_files{$dir}}, basename($src_file));
- }
- my %dst_cksums;
- read_cksums(\%dst_cksums, $dst_dir, 0);
- foreach my $src_dir (keys %src_files) {
- my %src_cksums;
- read_cksums(\%src_cksums, $src_dir, 0);
- foreach my $src_file (@{$src_files{$src_dir}}) {
- if (exists($src_cksums{$src_file})) {
+ die "ERROR while copying files\n";
+ }
+ my $src_sorted = sort_by_dir @$src;
+ my $dst_cksums = read_cksums $dst_dir;
+ return if !defined $dst_cksums;
+ my $files_touched = 0;
+ my $dirs_touched = 0;
+ foreach my $src_dir (keys %$src_sorted) {
+ my $src_cksums = read_cksums $src_dir;
+ next if !defined $src_cksums;
+ foreach my $src_file (@{$src_sorted->{$src_dir}}) {
+ my $src_path = "$src_dir/$src_file";
+ if (-d $src_path) {
+ my $dirs_touched = 1;
+ } else {
+ my $files_touched = 1;
+ }
+ if (exists $src_cksums->{$src_file}) {
if ($diff_name) {
- $dst_cksums{basename($dst)} = $src_cksums{$src_file};
+ $dst_cksums->{basename $dst} = $src_cksums->{$src_file};
} else {
- $dst_cksums{$src_file} = $src_cksums{$src_file};
+ $dst_cksums->{$src_file} = $src_cksums->{$src_file};
}
} else {
- print(STDERR "WARNING: \"$dst_dir/$src_file\" not in cksum or directory list.\n");
+ warn "WARNING: \"$src_path\" not in cksum or directory list\n";
}
}
}
- write_cksums($dst_dir, \%dst_cksums, 0);
+ write_cksums $dst_dir, $dst_cksums, $files_touched, $dirs_touched;
}
sub move_file {
my ($src, $dst) = @_;
if (-d $dst) {
- $dst = catdir($dst, basename($src));
+ $dst .= "/" . basename($src);
}
if (-e $dst) {
- print(STDERR "WARNING: \"$dst\" exists already. Do you want to replace it? ");
+ warn "WARNING: \"$dst\" exists already. Do you want to replace it?";
my $choice = <STDIN>;
chomp $choice;
if ($choice ne "y" && $choice ne "Y") {
t@@ -569,59 +451,78 @@ sub move_file {
}
sub move_from_same_dir {
- my ($src_dir, $src_files, $dst_dir) = @_;
- my %src_cksums;
- read_cksums(\%src_cksums, $src_dir, 0);
- my %dst_cksums;
- read_cksums(\%dst_cksums, $dst_dir, 0);
+ my ($src_dir, $src_files, $dst_cksums, $dst_dir) = @_;
+ my $src_cksums = read_cksums $src_dir;
+ return if !defined $src_cksums;
+ my $files_touched = 0;
+ my $dirs_touched = 0;
foreach my $src_file (@$src_files) {
- my $fullpath = catfile($src_dir, $src_file);
+ my $fullpath = "$src_dir/$src_file";
+ if (cmp_path($fullpath, $dst_dir)) {
+ warn "ERROR: can't move \"$fullpath\" into \"$dst_dir\" (same dir)\n";
+ next;
+ }
if (my $err = move_file($fullpath, $dst_dir)) {
- print(STDERR "$err\n");
+ warn "$err\n";
next;
}
- if (exists($src_cksums{$src_file})) {
- $dst_cksums{$src_file} = $src_cksums{$src_file};
- delete($src_cksums{$src_file});
+ if (-d $fullpath) {
+ $dirs_touched = 1;
+ } else {
+ $files_touched = 1;
+ }
+ if (exists $src_cksums->{$src_file}) {
+ $dst_cksums->{$src_file} = $src_cksums{$src_file};
+ delete $src_cksums->{$src_file};
} else {
- print(STDERR "WARNING: \"$dst_dir/$src_file\" not in cksum or directory list.\n");
+ warn "WARNING: \"$src_dir/$src_file\" not in cksum or directory list.\n";
}
}
- write_cksums($src_dir, \%src_cksums, 0);
- write_cksums($dst_dir, \%dst_cksums, 0);
+ write_cksums $src_dir, $src_cksums, $files_touched, $dirs_touched;
+ return ($files_touched, $dirs_touched);
}
sub move_rename {
my ($src, $dst) = @_;
- my $src_dir = dirname($src);
- my $dst_dir = dirname($dst);
- my $src_file = basename($src);
- my $dst_file = basename($dst);
- my %src_cksums;
- read_cksums(\%src_cksums, $src_dir, 0);
- my %dst_cksums;
+ my $src_dir = dirname $src;
+ my $dst_dir = dirname $dst;
+ my $src_file = basename $src;
+ my $dst_file = basename $dst;
+
+ my $src_cksums = read_cksums $src_dir;
+ return if !defined $src_cksums;
+ my $dst_cksums = {};
# if a file is simply being renamed in the same dir, the cksums
# should only be loaded and written once
if ($src_dir eq $dst_dir) {
- %dst_cksums = %src_cksums;
- delete($dst_cksums{$src_file});
+ %$dst_cksums = %$src_cksums;
+ delete $dst_cksums->{$src_file};
} else {
- read_cksums(\%dst_cksums, $dst_dir, 0);
+ $dst_cksums = read_cksums $dst_dir;
+ return if !defined $dst_cksums;
}
+
if (my $err = move_file($src, $dst)) {
- print(STDERR "$err\n");
+ warn "$err\n";
return;
}
- if (exists($src_cksums{$src_file})) {
- $dst_cksums{$dst_file} = $src_cksums{$src_file};
- delete($src_cksums{$src_file});
+ my $files_touched = 0;
+ my $dirs_touched = 0;
+ if (-d $src) {
+ $dirs_touched = 1;
} else {
- print(STDERR "WARNING: \"$dst\" not in cksum or directory list.\n");
+ $files_touched = 1;
}
+ if (exists($src_cksums->{$src_file})) {
+ $dst_cksums->{$dst_file} = $src_cksums->{$src_file};
+ delete $src_cksums->{$src_file};
+ } else {
+ warn "WARNING: \"$src\" not in cksum or directory list.\n";
+ }
+ write_cksums $dst_dir, $dst_cksums, $files_touched, $dirs_touched;
if ($src_dir ne $dst_dir) {
- write_cksums($src_dir, \%src_cksums, 0);
+ write_cksums $src_dir, $src_cksums, $files_touched, $dirs_touched;
}
- write_cksums($dst_dir, \%dst_cksums, 0);
}
sub cmp_path {
t@@ -635,92 +536,83 @@ sub cmp_path {
# $src: list of source paths
# $dst: destination directory or file (in latter case only one src is allowed)
sub move_files {
- my $src = shift;
- my $dst = shift;
+ my ($src, $dst) = @_;
foreach my $src_file (@$src) {
if ($src_file eq ".") {
- die("Can't move current directory (.)\n");
+ die "Can't move current directory (.)\n";
}
}
if (!-d $dst && $#$src != 0) {
- die("move: only one src argument allowed when dst is a file\n");
+ die "move: only one source argument allowed when destination is a file\n";
}
if (!-d $dst && !-d $src->[0]) {
- move_rename($src->[0], $dst);
+ move_rename $src->[0], $dst;
return;
}
if (!-e $dst && -d $src->[0]) {
- move_rename($src->[0], $dst);
+ move_rename $src->[0], $dst;
return;
}
if (-e $dst && !-d $dst && -d $src->[0]) {
- die("move: can't move directory to file\n");
+ die "move: can't move directory to file\n";
}
# Separate files by current dir so the cksum and dir files only need to be opened once
- my %src_files;
- foreach my $src_file (@$src) {
- if (!-e $src_file) {
- die("Source file \"$src_file\" doesn't exist.\n");
- }
- if (cmp_path($src_file, $dst)) {
- print(STDERR "ERROR: can't move \"$src_file\" into \"$dst\" (same dir)\n");
- next;
- }
- my $dir = dirname($src_file);
- if (!exists($src_files{$dir})) {
- $src_files{$dir} = [];
- }
- push(@{$src_files{$dir}}, basename($src_file));
- }
- foreach my $src_dir (keys %src_files) {
- move_from_same_dir($src_dir, $src_files{$src_dir}, $dst);
- }
+ my $src_files = sort_by_dir @$src;
+ my $dst_cksums = read_cksums $dst;
+ return if !defined $dst_cksums;
+ my $files_touched = 0;
+ my $dirs_touched = 0;
+ foreach my $src_dir (keys %$src_files) {
+ my ($tmp_files_touched, $tmp_dirs_touched) = move_from_same_dir $src_dir, $src_files{$src_dir}, $dst_cksums, $dst;
+ $files_touched ||= $tmp_files_touched;
+ $dirs_touched ||= $tmp_dirs_touched;
+ }
+ write_cksums $dst, $dst_cksums, $files_touched, $dirs_touched;
}
sub remove_file_dir {
my $path = shift;
if (-d $path) {
- remove_tree($path, {safe => 1}) or return "ERROR: can't remove \"$path\": $!";
+ remove_tree $path, {safe => 1} or return "ERROR: can't remove \"$path\": $!";
} else {
- unlink($path, {safe => 1}) or return "ERROR: can't remove \"$path\": $!";
+ unlink $path or return "ERROR: can't remove \"$path\": $!";
}
return 0;
}
sub remove_from_same_dir {
- my ($dir, $files) = @_;
- my %cksums;
- read_cksums(\%cksums, $dir, 0);
- foreach my $file (@$files) {
- my $fullpath = catfile($dir, $file);
+ my ($dir, @files) = @_;
+ my $cksums = read_cksums $dir;
+ return if !defined $cksums;
+ my $dirs_touched = 0;
+ my $files_touched = 0;
+ foreach my $file (@files) {
+ my $fullpath = "$dir/$file";
if (!-e $fullpath) {
- print(STDERR "\"$fullpath\": No such file or directory.\n");
+ warn "\"$fullpath\": No such file or directory.\n";
}
if (my $err = remove_file_dir($fullpath)) {
- print(STDERR "$err\n");
+ warn "$err\n";
next;
}
- if (exists($cksums{$file})) {
- delete($cksums{$file});
+ if (exists $cksums->{$file}) {
+ delete $cksums->{$file};
+ if (defined $cksums->{$file}) {
+ $files_touched = 1;
+ } else {
+ $dirs_touched = 1;
+ }
} else {
- print(STDERR "WARNING: \"$file\" not in cksum or directory list.\n");
+ warn "WARNING: \"$file\" not in cksum or directory list.\n";
}
}
- write_cksums($dir, \%cksums, 0);
+ write_cksums $dir, $cksums, $files_touched, $dirs_touched;
}
sub remove_files {
- my $files = shift;
- my %sorted_files;
- foreach my $file (@$files) {
- my $dir = dirname($file);
- if (!exists($sorted_files{$dir})) {
- $sorted_files{$dir} = [];
- }
- push(@{$sorted_files{$dir}}, basename($file));
- }
- foreach my $dir (keys %sorted_files) {
- remove_from_same_dir($dir, $sorted_files{$dir});
+ my $sorted_files = sort_by_dir @_;
+ foreach my $dir (keys %$sorted_files) {
+ remove_from_same_dir($dir, @{$sorted_files{$dir}});
}
}
t@@ -728,15 +620,17 @@ sub make_dirs {
my @created_dirs;
foreach (@_) {
if (system("mkdir", $_)) {
- print(STDERR "ERROR creating directory $_\n");
+ warn "ERROR creating directory $_\n";
+ next;
}
push(@created_dirs, $_);
}
# Separate files by current dir so the cksum and dir files only need to be opened once
my %dirs;
foreach my $dir (@created_dirs) {
- # FiXME: seems a bit ugly (must write cksums in new dir for it to work later)
- write_cksums($dir, {}, 0);
+ system("touch", "$dir/.lumidify_archive_cksums");
+ system("touch", "$dir/.lumidify_archive_dirs");
+ write_special_cksums $dir, ".lumidify_archive_cksums", ".lumidify_archive_dirs";
my $parent = dirname($dir);
if (!exists($dirs{$parent})) {
$dirs{$parent} = [];
t@@ -744,12 +638,12 @@ sub make_dirs {
push(@{$dirs{$parent}}, basename($dir));
}
foreach my $parent (keys %dirs) {
- my %cksums;
- read_cksums(\%cksums, $parent, 0);
+ my $parent_dirs = read_file "$parent/.lumidify_archive_dirs";
+ next if !defined $parent_dirs;
foreach my $dir (@{$dirs{$parent}}) {
- $cksums{$dir} = {};
+ $parent_dirs->{$dir} = "";
}
- write_cksums($parent, \%cksums, 0);
+ write_file "$parent/.lumidify_archive_dirs", $parent_dirs;
}
}
t@@ -773,44 +667,32 @@ if ($ARGV[0] eq "mv") {
if ($#ARGV > 0) {
$dir = $ARGV[1];
}
- my $cksums = init_cksums($dir);
- check_add_new_files($dir, $cksums);
- write_cksums($dir, $cksums, 1);
+ check_add_new_files($dir);
} elsif ($ARGV[0] eq "cknew") {
my $dir = ".";
if ($#ARGV > 0) {
$dir = $ARGV[1];
}
- my $cksums = init_cksums($dir);
- my $new_files = check_new_files($dir, $cksums);
- print(Dumper($new_files));
-} elsif ($ARGV[0] eq "init") {
+ check_new_files($dir);
+} elsif ($ARGV[0] eq "check") {
my $dir = ".";
if ($#ARGV > 0) {
$dir = $ARGV[1];
- }
- # FIXME: at least first recurse through dirs and check if any contain cksums
- my $cksums = {};
- check_add_new_files($dir, $cksums);
- write_cksums($dir, $cksums, 1);
-} elsif ($ARGV[0] eq "check") {
- if ($#ARGV > 0) {
- my $dir = $ARGV[1];
if (!-d $dir) {
- die("ERROR: Directory \"$dir\" does not exist.\n");
+ die "ERROR: Directory \"$dir\" does not exist.\n";
}
chdir($dir);
}
- check_files();
+ check_files($dir);
} elsif ($ARGV[0] eq "clean") {
+ my $dir = ".";
if ($#ARGV > 0) {
- my $dir = $ARGV[1];
+ $dir = $ARGV[1];
if (!-d $dir) {
- die("ERROR: Directory \"$dir\" does not exist.\n");
+ die "ERROR: Directory \"$dir\" does not exist.\n";
}
- chdir($dir);
}
- clean_files();
+ clean_files($dir);
} elsif ($ARGV[0] eq "extract") {
my $src_dir = ".";
my $dst_dir;
t@@ -843,11 +725,4 @@ if ($ARGV[0] eq "mv") {
}
my @dirs = @ARGV[1..$#ARGV];
make_dirs(@dirs);
-} elsif ($ARGV[0] eq "convert") {
- my $dir = ".";
- if ($#ARGV > 0) {
- $dir = $ARGV[1];
- }
- my $cksums = init_cksums_old($dir);
- write_cksums($dir, $cksums, 1);
}