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

From: Paul Procacci <pprocacci_at_gmail.com>
Date: Fri, 05 May 2023 07:01:14 UTC
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 /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
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 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
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

-- 
__________________

:(){ :|:& };: