Re: Tool to compare directories and delete duplicate files from one directory

From: Kaya Saman <kayasaman_at_optiplex-networks.com>
Date: Fri, 05 May 2023 07:51:37 UTC
Paul, that's fantastic!! Thank you so much!

It works!!


Now to test on the live system... guess I should take a zfs snapshot 
before messing around with things :-)


I really appreciate this :-D


Best regards,


Kaya


On 5/5/23 08:01, Paul Procacci wrote:
>
>
>
> On Fri, May 5, 2023 at 12:06 AM Kaya Saman 
> <kayasaman@optiplex-networks.com> wrote:
>
>
>     On 5/5/23 04:36, Paul Procacci wrote:
>     > #!/usr/bin/env perl
>     >
>     > use strict;
>     > use warnings;
>     >
>     > sub msgDie
>     > {
>     >   my ($ret) = shift;
>     >   my ($msg) = shift // "$0 dir_base dir\n";
>     >   print $msg;
>     >   exit($ret);
>     > }
>     >
>     > msgDie(1) unless(scalar @ARGV eq 2);
>     >
>     > my $base = $ARGV[0];
>     > my $dir  = $ARGV[1];
>     >
>     > msgDie(1, "base directory doesn't exist\n") unless -d $base;
>     > msgDie(1, "source directory doesn't exist\n") unless -d $dir;
>     >
>     > opendir(my $dh, $dir) or msgDie("Unable to open directory: $dir\n");
>     > while(readdir $dh)
>     > {
>     >   next if($_ eq '.' || $_ eq '..');
>     >   next if(! -f "$base/$_");
>     >
>     >   my ($ref) = (stat("$base/$_"))[7];
>     >   my ($src) = (stat("$dir/$_"))[7];
>     >   unlink("$dir/$_") if($ref == $src);
>     > }
>
>
>     To start with this is the directory structure:
>
>
>       ls -lhR /tmp/test1
>     total 1
>     drwxr-xr-x  2 root  wheel     3B May  5 04:57 dupdir1
>     drwxr-xr-x  2 root  wheel     3B May  5 04:57 dupdir2
>
>     /tmp/test1/dupdir1:
>     total 1
>     -rw-r--r--  1 root  wheel     8B Apr 30 03:17 dup
>
>     /tmp/test1/dupdir2:
>     total 1
>     -rw-r--r--  1 root  wheel     7B May  5 03:23 dup1
>
>
>     ls -lhR /tmp/test2
>     total 1
>     drwxr-xr-x  2 root  wheel     3B May  5 04:56 dupdir1
>     drwxr-xr-x  2 root  wheel     3B May  5 04:56 dupdir2
>
>     /tmp/test2/dupdir1:
>     total 1
>     -rw-r--r--  1 root  wheel     4B Apr 30 02:53 dup
>
>     /tmp/test2/dupdir2:
>     total 1
>     -rw-r--r--  1 root  wheel     7B Apr 30 02:47 dup1
>
>
>     So what I want to happen is the script to recurse from the top level
>     directories test1 and test2 then expected behavior should be to
>     remove
>     file dup1 as dup is different between directories.
>
>
>     I ran the script and again it didn't produce any output?
>
>     ./test.pl <http://test.pl> /tmp/test1 /tmp/test2
>
>
>     I'm not sure if I need any other perl module? It is installed:
>
>     p5-ExtUtils-Config-0.008_1     Wrapper for perl configuration
>     perl5-5.32.1_3                 Practical Extraction and Report
>     Language
>
>
>     I have many p5- modules too installed but maybe I don't have the
>     right
>     ones to run the script?
>
>
>
>
> - My script doesn't have any output.
> - My script doesn't recurse directories.
> - My script requires no modules.
> - You just need perl5 installed.
>
> So you want something like this:
>
> % find test* -type f -ls
> 131318        9 -rwxr-xr-x    1 pprocacci    pprocacci                 
>             763 May  5 06:58 test.pl <http://test.pl>
> 132503        9 -rw-r--r--    1 pprocacci    pprocacci                 
>               5 May  5 06:52 test1/dupdir2/dup1
> 132898        9 -rw-r--r--    1 pprocacci    pprocacci                 
>               8 May  5 06:51 test1/dupdir1/dup
> 132771        9 -rw-r--r--    1 pprocacci    pprocacci                 
>               4 May  5 06:52 test2/dupdir1/dup
> 133006        9 -rw-r--r--    1 pprocacci    pprocacci                 
>               5 May  5 06:52 test2/dupdir2/dup1
>
> And after the run of the perl script like so:
> % ./test.pl <http://test.pl> test1 test2
>
> You want it to be like this:
>
> % find test* -type f -ls
> 131318        9 -rwxr-xr-x    1 pprocacci      pprocacci               
>               763 May  5 06:58 test.pl <http://test.pl>
> 132503        9 -rw-r--r--    1 pprocacci      pprocacci               
>                 5 May  5 06:52 test1/dupdir2/dup1
> 132898        9 -rw-r--r--    1 pprocacci      pprocacci               
>                 8 May  5 06:51 test1/dupdir1/dup
> 132771        9 -rw-r--r--    1 pprocacci      pprocacci               
>                 4 May  5 06:52 test2/dupdir1/dup
>
> If so:
>
> ####################################################
> #!/usr/bin/env perl
>
> use strict;
> use warnings;
>
> sub msgDie
> {
>   my ($ret) = shift;
>   my ($msg) = shift // "$0 dir_base dir\n";
>   print $msg;
>   exit($ret);
> }
>
> sub doit
> {
>   my($base, $cur) = @_;
>
>   opendir(my $dh, $cur) or msgDie("Unable to open directory: $cur\n");
>   while(readdir $dh)
>   {
>     next if($_ eq '.' || $_ eq '..');
>     if(-d "$cur/$_"){ doit("$base/$_", "$cur/$_"); next; }
>     next if(! -f "$base/$_");
>
>     my ($ref) = (stat("$base/$_"))[7];
>     my ($src) = (stat("$cur/$_"))[7];
>     unlink("$cur/$_") if($ref == $src);
>   }
> }
>
> msgDie(1) unless(scalar @ARGV eq 2);
>
> my $base = $ARGV[0];
> my $dir  = $ARGV[1];
>
> msgDie(1, "base diretory doesn't exist\n") unless -d $base;
> msgDie(1, "source diretory doesn't exist\n") unless -d $dir;
>
> doit($base, $dir);
> ####################################################
>
> ~Paul
>
> -- 
> __________________
>
> :(){ :|:& };: