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 -- __________________ :(){ :|:& };: