Browse Source

add --dry-run and basename collision-checking to mark-mv & mark-cp

Adds App::MarkFile::check_collisions().  Right now this just bails if
something would be weird.  An option to solve interactively is probably
a good idea, but for now this will at least prevent the obvious
foot-shooting case.

Of course it should probably also list the overlapping source paths...
Brennen Bearnes 5 months ago
parent
commit
bf21b27d24
3 changed files with 76 additions and 25 deletions
  1. 23
    1
      bin/mark-cp
  2. 28
    23
      bin/mark-mv
  3. 25
    1
      lib/App/MarkFiles.pm

+ 23
- 1
bin/mark-cp View File

@@ -4,12 +4,29 @@ use warnings;
4 4
 use strict;
5 5
 use 5.10.0;
6 6
 
7
-use App::MarkFiles qw(each_path);
7
+use App::MarkFiles qw(each_path check_collisions);
8 8
 use File::Basename;
9 9
 use File::Copy;
10 10
 use File::Spec;
11 11
 use Getopt::Long;
12 12
 
13
+
14
+my $dry_run;
15
+GetOptions(
16
+  'no-action|dry-run|n' => \$dry_run,
17
+  help                  => sub { pod2usage(0) },
18
+) or pod2usage(2);
19
+
20
+my (@collisions) = check_collisions();
21
+if (scalar @collisions) {
22
+  # We got something.  Alert the user and bail.
23
+  say "Multiple marked paths would be copied to the following filenames:";
24
+  say join "\n", @collisions;
25
+  say "";
26
+  say "No action taken, since this probably isn't what you want.";
27
+  exit(1);
28
+}
29
+
13 30
 each_path(sub {
14 31
   my ($path) = @_;
15 32
 
@@ -26,6 +43,11 @@ each_path(sub {
26 43
     # See mark-mv for some discussion of what happens if target exists.
27 44
   }
28 45
 
46
+  if ($dry_run) {
47
+    say "Would copy: $path";
48
+    return;
49
+  }
50
+
29 51
   if (copy($path, './')) {
30 52
     say "Copied: $path";
31 53
   } else {

+ 28
- 23
bin/mark-mv View File

@@ -4,14 +4,30 @@ use warnings;
4 4
 use strict;
5 5
 use 5.10.0;
6 6
 
7
-use App::MarkFiles qw(each_path remove);
7
+use App::MarkFiles qw(each_path remove check_collisions);
8 8
 use File::Basename;
9 9
 use File::Copy;
10 10
 use File::Spec;
11 11
 use Getopt::Long;
12
+use Pod::Usage;
12 13
 
13
-my @unmark;
14
+my $dry_run;
15
+GetOptions(
16
+  'no-action|dry-run|n' => \$dry_run,
17
+  help                  => sub { pod2usage(0) },
18
+) or pod2usage(2);
19
+
20
+my (@collisions) = check_collisions();
21
+if (scalar @collisions) {
22
+  # We got something.  Alert the user and bail.
23
+  say "Multiple marked paths would move to the following filenames:";
24
+  say join "\n", @collisions;
25
+  say "";
26
+  say "No action taken, since this probably isn't what you want.";
27
+  exit(1);
28
+}
14 29
 
30
+my @unmark;
15 31
 each_path(sub {
16 32
   my ($path) = @_;
17 33
 
@@ -25,27 +41,12 @@ each_path(sub {
25 41
 
26 42
   if (-e $target) {
27 43
     say "Warning: $path will overwrite $target";
44
+  }
28 45
 
29
-    # So here's the question.  What do we do if the target exists?
30
-    #
31
-    # There are a couple of cases here:
32
-    #
33
-    # 1. Our mark list contains a file of the same name as something already in
34
-    # the destination directory.
35
-    #
36
-    # 2. Our mark list contains the same filename more than once.
37
-    #
38
-    # These seem like distinct problems, to a degree.  #1 is effectively
39
-    # standard unix behavior, and I'm not sure we need to protect the user from
40
-    # it unless they ask us to with a -i option or something.  #2 is more
41
-    # problematic.  No matter what you do, you're likely to wind up with
42
-    # unexpected outcomes.
43
-    #
44
-    # We could refuse to operate unless a "rename duplicates" option is
45
-    # invoked, or just interactively solve each collision.  This seems most
46
-    # pressing for mark-mv, since it could easily result in data loss by
47
-    # cascading a set of moves where you wind up with just one source file
48
-    # left anywhere.
46
+  if ($dry_run) {
47
+    say "Would move: $path";
48
+    push @unmark, $path;
49
+    return;
49 50
   }
50 51
 
51 52
   if (move($path, $target)) {
@@ -56,4 +57,8 @@ each_path(sub {
56 57
   }
57 58
 });
58 59
 
59
-remove(@unmark);
60
+if ($dry_run) {
61
+  say "Would remove marks from: " . join ', ', @unmark;
62
+} else {
63
+  remove(@unmark);
64
+}

+ 25
- 1
lib/App/MarkFiles.pm View File

@@ -62,11 +62,12 @@ use strict;
62 62
 use warnings;
63 63
 
64 64
 use base qw(Exporter);
65
-our @EXPORT_OK = qw(get_dbh each_path add remove);
65
+our @EXPORT_OK = qw(get_dbh each_path add remove check_collisions);
66 66
 
67 67
 our ($VERSION) = '0.0.1';
68 68
 
69 69
 use DBI;
70
+use File::Basename;
70 71
 use File::HomeDir;
71 72
 use File::Spec;
72 73
 
@@ -181,6 +182,29 @@ sub each_path {
181 182
   }
182 183
 }
183 184
 
185
+=item check_collisions()
186
+
187
+Return a list of basenames which would collide from the current list.
188
+
189
+=cut
190
+
191
+sub check_collisions {
192
+  # Accumulate a list of basenames:
193
+  my %basenames;
194
+  each_path(sub {
195
+    my ($path) = @_;
196
+    my ($source_basename, $source_path) = fileparse($path);
197
+    $basenames{ $source_basename }++;
198
+  });
199
+
200
+  my @collisions;
201
+  while(my($basename, $count) = each %basenames) {
202
+    push @collisions, $basename if 1 < $count;
203
+  }
204
+
205
+  return @collisions;
206
+}
207
+
184 208
 =back
185 209
 
186 210
 =head1 AUTHOR