Re: Tool to compare directories and delete duplicate files from one directory
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
--
__________________
:(){ :|:& };: