commit f35b80dd2c875acfa769b7f1e69346c43e8cdf27
parent fae257684466739cf66a0f1d32f38e86c41c89fd
Author: lumidify <nobody@lumidify.org>
Date: Tue, 24 Mar 2020 11:02:16 +0100
Lots of small fixes; more documentation; better option parsing
Diffstat:
| M | lumia.pl | | | 289 | +++++++++++++++++++++++++++++++++++++++++++++++++------------------------------ |
1 file changed, 178 insertions(+), 111 deletions(-)
diff --git a/lumia.pl b/lumia.pl
@@ -2,8 +2,6 @@
# FIXME: some way to avoid writing .lumidify* in dirs but still index them? e.g. Code/CMSG
# FIXME: cksum don't create malformed line if permission denied
-# FIXME: make generic function to traverse dirs and call other function on each dir
-# FIXME: handle rm, etc. on .lumidify* files
# FIXME: ignore all except for a certain file/folder
# FIXME: store modified date and checksum filed with changed date
# FIXME: allow different hash types
@@ -18,6 +16,7 @@ use File::Basename qw(basename dirname);
use File::Path qw(remove_tree);
use String::ShellQuote;
use Pod::Usage;
+use Getopt::Std;
# the file used to store checksums for files
my $CKSUM_FILE = ".lumidify_archive_cksums";
@@ -110,9 +109,9 @@ sub clean_files {
my $iter = make_file_iter_basic sub {exists $SPECIAL_FILES{basename $_[0]};}, $dir;
while (my $file = $iter->()) {
if (!unlink $file) {
- warn "WARNING: Unable to remove file \"$file\"!";
+ warn "WARNING: Unable to remove file \"$file\"!\n";
} else {
- print "Deleted \"$file\"";
+ print "Deleted \"$file\"\n";
}
}
}
@@ -231,35 +230,40 @@ sub check_cksums {
return $failed;
}
-# check the checksums of all files in $top_dir
+# check the checksums of all files and directories in @dirs
sub check_files {
- my $iter = make_lumia_iter @_;
- while (my $file = $iter->()) {
+ my $args = shift;
+ my @dirs;
+ foreach my $file (@_) {
if (-d $file) {
- check_cksums $file, $DOUBLE_CKSUM_FILE;
- check_cksums $file, $CKSUM_FILE;
+ push @dirs, $file;
+ next;
+ }
+ my $dir = dirname $file;
+ my $base = basename $file;
+ if (exists $SPECIAL_FILES{$base}) {
+ warn "ERROR: File is reserved for lumia.pl: $file\n";
+ next;
+ }
+ my $cksums = read_cksum_file("$dir/$CKSUM_FILE");
+ next if !defined $cksums;
+ if (!exists $cksums->{$base}) {
+ warn "ERROR: File doesn't exist in checksums: $file\n";
+ next;
+ }
+ my $output = get_cksum "$file";
+ next if !defined $output;
+ if ($output eq $cksums->{$base}) {
+ print "OK $file\n" if !$args->{"q"};
} else {
- my $dir = dirname $file;
- my $base = basename $file;
- if (exists $SPECIAL_FILES{$base}) {
- warn "ERROR: File is reserved for lumia.pl: $file\n";
- next;
- }
- my $cksums = read_cksum_file("$dir/$CKSUM_FILE");
- next if !defined $cksums;
- if (!exists $cksums->{$base}) {
- warn "ERROR: File doesn't exist in checksums: $file\n";
- next;
- }
- my $output = get_cksum "$file";
- next if !defined $output;
- if ($output eq $cksums->{$base}) {
- print "OK $file\n";
- } else {
- print "FAILED $file\n";
- }
+ print "FAILED $file\n";
}
}
+ my $iter = make_lumia_iter @dirs;
+ while (my $file = $iter->()) {
+ check_cksums $file, $DOUBLE_CKSUM_FILE, $args->{"q"};
+ check_cksums $file, $CKSUM_FILE, $args->{"q"};
+ }
}
# write the checksums of the special lumia files given as arguments
@@ -289,7 +293,7 @@ sub write_special_cksums {
# files in each directory that has new files
sub check_new_files {
my ($dir, $file_func, $before_dir_func, $after_dir_func) = @_;
- my $iter = make_file_iter sub {-d $_[0]}, sub {
+ my $iter = make_file_iter sub {1}, sub {
my $dir = shift;
my $dh;
if (!opendir $dh, $dir) {
@@ -421,18 +425,38 @@ sub write_cksum_file {
# any keys that point to undef are taken to be directories and vice versa
# $files_modified and $dirs_modified control which of the special lumia
# files actually get written
+# note: this doesn't use write_file, etc. in order to (possibly) be a bit more efficient
sub write_cksums {
my ($dir, $contents, $files_modified, $dirs_modified) = @_;
# No, this isn't efficient...
+ my @special_files;
+ my $dirs_fh;
+ my $files_fh;
if ($files_modified) {
- my %file_cksums = map {$_ => $contents->{$_}} grep({defined $contents->{$_}} keys %$contents);
- write_cksum_file("$dir/$CKSUM_FILE", \%file_cksums);
- write_special_cksums $dir, $CKSUM_FILE;
+ my $path = "$dir/$CKSUM_FILE";
+ if (!open $files_fh, ">", $path) {
+ warn "ERROR: Unable to open \"$path\" for writing!";
+ return;
+ }
+ push @special_files, $CKSUM_FILE;
}
if ($dirs_modified) {
- my %dir_cksums = map {$_ => undef} grep({!defined $contents->{$_}} keys %$contents);
- write_file "$dir/$DIR_FILE", \%dir_cksums;
- write_special_cksums $dir, $DIR_FILE;
+ my $path = "$dir/$DIR_FILE";
+ if (!open $dirs_fh, ">", $path) {
+ warn "ERROR: Unable to open \"$path\" for writing!";
+ return;
+ }
+ push @special_files, $DIR_FILE;
+ }
+ foreach my $key (keys %$contents) {
+ if ($files_modified && defined $contents->{$key}) {
+ print $files_fh $contents->{$key} . ' "' . escape_filename($key) . '"' . "\n";
+ } elsif ($dirs_modified && !defined $contents->{$key}) {
+ print $dirs_fh '"' . escape_filename($key) . '"' . "\n";
+ }
+ }
+ if (@special_files) {
+ write_special_cksums $dir, @special_files;
}
}
@@ -533,7 +557,7 @@ sub prompt_overwrite {
# $src: list of source paths
# $dst: destination directory or file (in latter case only one src is allowed)
sub copy_files {
- my ($src, $dst) = @_;
+ my ($src, $dst, $args) = @_;
my $dst_dir = $dst;
if (!-d $dst) {
$dst_dir = dirname $dst;
@@ -559,12 +583,17 @@ sub copy_files {
my $src_path = "$src_dir/$src_file";
my $dst_path = $diff_name ? $dst : "$dst_dir/$src_file";
+ if (-d $dst_path && -d $src_path) {
+ warn "ERROR: Cannot copy directory to already existing directory\n";
+ next;
+ }
if (exists $SPECIAL_FILES{$src_file} || exists $SPECIAL_FILES{basename $dst_path}) {
warn "ERROR: Not copying special file\n";
next;
}
- next if prompt_overwrite($dst_path);
- next if system("cp", "-av", $src_path, $dst);
+ next if !$args->{"f"} && prompt_overwrite($dst_path);
+ my $options = $args->{"v"} ? "-av" : "-a";
+ next if system("cp", $options, "--", $src_path, $dst);
if (-d $src_path) {
$dirs_touched = 1;
@@ -589,7 +618,7 @@ sub copy_files {
# move a file (or directory) from $src to $dst, prompting for confirmation if $dst already exists;
# automatically appends the basename of $src to $dst if $dst is a directory
sub move_file {
- my ($src, $dst) = @_;
+ my ($src, $dst, $args) = @_;
if (exists $SPECIAL_FILES{basename $src} || exists $SPECIAL_FILES{basename $dst}) {
warn "ERROR: Not moving special file\n";
return 1;
@@ -597,15 +626,26 @@ sub move_file {
if (-d $dst) {
$dst .= "/" . basename($src);
}
- return 1 if prompt_overwrite($dst);
- return system("mv", $src, $dst);
+ return 1 if !$args->{"f"} && prompt_overwrite($dst);
+ my $ret;
+ if ($args->{"v"}) {
+ $ret = system("mv", "-v", "--", $src, $dst);
+ } else {
+ $ret = system("mv", "--", $src, $dst);
+ }
+ return 1 if $ret;
+ if (-e $src) {
+ warn "ERROR: file could not be removed from source but will still be " .
+ "removed from checksum database\n";
+ }
+ return 0;
}
# move all files/directories in $src_files from $src_dir to $dst_dir ($src_files
# only contains the basenames of the files), removing them from the checksum files
# in $src_dir and adding them to $dst_cksums
sub move_from_same_dir {
- my ($src_dir, $src_files, $dst_cksums, $dst_dir) = @_;
+ my ($src_dir, $src_files, $dst_cksums, $dst_dir, $args) = @_;
my $src_cksums = read_cksums $src_dir;
return if !defined $src_cksums;
my $files_touched = 0;
@@ -620,7 +660,7 @@ sub move_from_same_dir {
$tmp_files_touched = 1;
}
- next if move_file($fullpath, $dst_dir);
+ next if move_file($fullpath, $dst_dir, $args);
# need to be able to check if the path is a directory
# before actually moving it
@@ -639,7 +679,7 @@ sub move_from_same_dir {
# rename a single file or directory from $src to $dst
sub move_rename {
- my ($src, $dst) = @_;
+ my ($src, $dst, $args) = @_;
my $src_dir = dirname $src;
my $dst_dir = dirname $dst;
my $src_file = basename $src;
@@ -666,7 +706,7 @@ sub move_rename {
$files_touched = 1;
}
- return if move_file($src, $dst);
+ return if move_file($src, $dst, $args);
if (exists($src_cksums->{$src_file})) {
$dst_cksums->{$dst_file} = $src_cksums->{$src_file};
@@ -689,16 +729,16 @@ sub move_rename {
# $src: list of source paths
# $dst: destination directory or file (in latter case only one src is allowed)
sub move_files {
- my ($src, $dst) = @_;
+ my ($src, $dst, $args) = @_;
if (!-d $dst && $#$src != 0) {
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, $args;
return;
}
if (!-e $dst && -d $src->[0]) {
- move_rename $src->[0], $dst;
+ move_rename $src->[0], $dst, $args;
return;
}
if (-e $dst && !-d $dst && -d $src->[0]) {
@@ -711,7 +751,7 @@ sub move_files {
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;
+ my ($tmp_files_touched, $tmp_dirs_touched) = move_from_same_dir $src_dir, $src_files->{$src_dir}, $dst_cksums, $dst, $args;
$files_touched ||= $tmp_files_touched;
$dirs_touched ||= $tmp_dirs_touched;
}
@@ -720,11 +760,14 @@ sub move_files {
# remove a file or directory from the filesystem
sub remove_file_dir {
- my $path = shift;
- if (-d $path) {
- remove_tree $path, {safe => 1} or return "ERROR: can't remove \"$path\": $!";
- } else {
- unlink $path or return "ERROR: can't remove \"$path\": $!";
+ my ($path, $args) = @_;
+ my $options = $args->{"f"} ? "-rf" : "-f";
+ if (system("rm", $options, "--", $path)) {
+ return 1;
+ }
+ if (-e $path) {
+ warn "ERROR: unable to remove \"$path\" from filesystem but " .
+ "will still be removed from checksum database\n";
}
return 0;
}
@@ -733,7 +776,7 @@ sub remove_file_dir {
# note: the files are only allowed to be basenames, i.e., they must be the
# actual filenames present in the checksum files
sub remove_from_same_dir {
- my ($dir, @files) = @_;
+ my ($args, $dir, @files) = @_;
my $cksums = read_cksums $dir;
return if !defined $cksums;
my $dirs_touched = 0;
@@ -747,10 +790,7 @@ sub remove_from_same_dir {
if (!-e $fullpath) {
warn "\"$fullpath\": No such file or directory.\n";
}
- if (my $err = remove_file_dir($fullpath)) {
- warn "$err\n";
- next;
- }
+ next if remove_file_dir($fullpath, $args);
if (exists $cksums->{$file}) {
if (defined $cksums->{$file}) {
$files_touched = 1;
@@ -768,9 +808,10 @@ sub remove_from_same_dir {
# remove all given files and directories, updating the appropriate checksum
# files in the process
sub remove_files {
+ my $args = shift;
my $sorted_files = sort_by_dir(@_);
foreach my $dir (keys %$sorted_files) {
- remove_from_same_dir($dir, @{$sorted_files->{$dir}});
+ remove_from_same_dir($args, $dir, @{$sorted_files->{$dir}});
}
}
@@ -780,7 +821,7 @@ sub remove_files {
sub make_dirs {
my @created_dirs;
foreach (@_) {
- if (system("mkdir", $_)) {
+ if (system("mkdir", "--", $_)) {
warn "ERROR creating directory $_\n";
next;
}
@@ -815,11 +856,11 @@ sub extract {
while (my $dir = $iter->()) {
my $final_dir = abs2rel $dir, $src_dir;
my $fulldir = catfile $dst_dir, $final_dir;
- system("mkdir", "-p", $fulldir);
+ system("mkdir", "-p", "--", $fulldir);
foreach my $file (keys %SPECIAL_FILES) {
my $filepath = catfile $dir, $file;
if (-e $filepath) {
- system("cp", "-aiv", $filepath, catfile($fulldir, $file));
+ system("cp", "-aiv", "--", $filepath, catfile($fulldir, $file));
}
}
}
@@ -854,63 +895,66 @@ sub update {
}
}
-pod2usage(-verbose => 1) if $#ARGV < 0;
+my %args;
+getopts("fqh", \%args);
-if ($ARGV[0] eq "mv") {
- if ($#ARGV < 2) {
- die "mv requires at least two arguments\n";
- }
- my @src = @ARGV[1..$#ARGV-1];
- move_files(\@src, $ARGV[-1]);
-} elsif ($ARGV[0] eq "rm") {
- if ($#ARGV < 1) {
+pod2usage(-verbose => 1) if @ARGV < 1 || $args{"h"};
+
+my $cmd = shift;
+
+if ($cmd eq "mv") {
+ die "mv requires at least two arguments\n" if @ARGV < 2;
+ my @src = @ARGV[0..$#ARGV-1];
+ move_files(\@src, $ARGV[-1], \%args);
+} elsif ($cmd eq "rm") {
+ if (@ARGV < 1) {
die "rm requires at least one argument\n";
}
- remove_files(@ARGV[1..$#ARGV]);
-} elsif ($ARGV[0] eq "addnew") {
+ remove_files \%args, @ARGV;
+} elsif ($cmd eq "addnew") {
my $dir = ".";
- if ($#ARGV > 0) {
- $dir = $ARGV[1];
+ if (@ARGV >= 1) {
+ $dir = $ARGV[0];
}
check_add_new_files $dir;
-} elsif ($ARGV[0] eq "checknew") {
+} elsif ($cmd eq "checknew") {
my $dir = ".";
- if ($#ARGV > 0) {
- $dir = $ARGV[1];
+ if (@ARGV >= 1) {
+ $dir = $ARGV[0];
}
check_new_files $dir;
-} elsif ($ARGV[0] eq "checkold") {
+} elsif ($cmd eq "checkold") {
my $dir = ".";
- if ($#ARGV > 0) {
- $dir = $ARGV[1];
+ if (@ARGV >= 1) {
+ $dir = $ARGV[0];
}
check_old_files $dir;
-} elsif ($ARGV[0] eq "rmold") {
+} elsif ($cmd eq "rmold") {
my $dir = ".";
- if ($#ARGV > 0) {
- $dir = $ARGV[1];
+ if (@ARGV >= 1) {
+ $dir = $ARGV[0];
}
remove_old_files $dir;
-} elsif ($ARGV[0] eq "check") {
- if ($#ARGV < 1) {
- check_files ".";
+} elsif ($cmd eq "check") {
+ if (@ARGV < 1) {
+ check_files \%args, ".";
} else {
- check_files @ARGV[1..$#ARGV];
+ check_files \%args, @ARGV;
}
-} elsif ($ARGV[0] eq "clean") {
+} elsif ($cmd eq "clean") {
my $dir = ".";
- if ($#ARGV > 0) {
- $dir = $ARGV[1];
+ if (@ARGV >= 1) {
+ $dir = $ARGV[0];
}
clean_files $dir;
-} elsif ($ARGV[0] eq "extract") {
+} elsif ($cmd eq "extract") {
my $src_dir = ".";
my $dst_dir;
- if ($#ARGV > 1) {
- $src_dir = $ARGV[1];
- $dst_dir = $ARGV[2];
- } elsif ($#ARGV == 1) {
- $dst_dir = $ARGV[1];
+ if (@ARGV >= 2) {
+ $src_dir = $ARGV[0];
+ $dst_dir = $ARGV[1];
+ } elsif (@ARGV == 1) {
+ $dst_dir = $ARGV[0];
} else {
die "ERROR: `extract` requires at least a destination directory.\n";
}
@@ -921,24 +965,23 @@ if ($ARGV[0] eq "mv") {
die "ERROR: Directory \"$dst_dir\" does not exist.\n";
}
extract $src_dir, $dst_dir;
-} elsif ($ARGV[0] eq "cp") {
- if ($#ARGV < 2) {
+} elsif ($cmd eq "cp") {
+ if (@ARGV < 2) {
die "cp requires at least two arguments\n";
}
- my @src = @ARGV[1..$#ARGV-1];
- copy_files(\@src, $ARGV[-1]);
-} elsif ($ARGV[0] eq "mkdir") {
- if ($#ARGV < 1) {
+ my @src = @ARGV[0..$#ARGV-1];
+ copy_files \@src, $ARGV[-1], \%args;
+} elsif ($cmd eq "mkdir") {
+ if (@ARGV < 1) {
die "mkdir requires at least one argument\n";
}
- my @dirs = @ARGV[1..$#ARGV];
- make_dirs(@dirs);
-} elsif ($ARGV[0] eq "update") {
- if ($#ARGV < 1) {
+ make_dirs @ARGV;
+} elsif ($cmd eq "update") {
+ if (@ARGV < 1) {
die "update requires at least one argument\n";
}
- update @ARGV[1..$#ARGV];
-} elsif ($ARGV[0] eq "help") {
+ update @ARGV;
+} elsif ($cmd eq "help") {
pod2usage(-exitval => 0, -verbose => 2);
}
@@ -950,7 +993,7 @@ lumia.pl - Manage checksums on a filesystem
=head1 SYNOPSIS
-B<lumia.pl> command arguments
+B<lumia.pl> [-qfh] command arguments
=head1 OPTIONS
@@ -1030,6 +1073,30 @@ into it.
=back
+=head1 CAVEATS
+
+B<rm> automatically deletes the files recursively. For each of the arguments,
+the following caveats apply:
+If any actual errors occur while deleting the file/directory (i.e. the system
+command C<rm> returns a non-zero exit value), the checksum or directory B<is
+left in the database>. If the system C<rm> does not return a non-zero exit value,
+but the file/directory still exists afterwards (e.g. there was a permission
+error and the user answered "n" when prompted), a warning message is printed,
+but the files B<are removed from the database> (if the database can be
+written to).
+
+B<mv> behaves the same as B<rm> with regards to checking if the source file
+is still present after the operation.
+
+B<cp> will issue a warning and skip to the next argument if it is asked to
+merge a directory with an already existing directory. For instance, attempting
+to run C<cp dir1 dir2>, where C<dir2> already contains a directory named
+C<dir1>, will result in an error. This may change in the future, when the
+program is modified to recursively copy the files manually, instead of simply
+calling the system C<cp> on each of the arguments. If this was supported in
+the current version, none of the checksums inside that directory would be
+updated, so it wouldn't be very useful.
+
=head1 LICENSE
Copyright (c) 2019, 2020 lumidify <nobody[at]lumidify.org>
