How to Pinpoint Unmatch Segment/Parse Between Two Paths Perl - perl

Question

I have 2 paths that need to be compared, and if it is unmatch, I want to point out which sub-path or path that is not match. Is there any better way to do this? This is just for 2 path, I have a lot of paths that need to be compared.
#!/usr/bin/perl
use warnings;
use strict;
my $realPath= 'C/library/media/music/retro/perl.mp3'; #Absolute
my $comparedPath= 'music/classic/perl.mp3'; #Relative, a sample that need to be compare with the $realPath
my #compared_array;
my #realpath_array;
my %compared_hash;
tie %compared_hash, 'Tie::IxHash';
my %realpath_hash;
tie %realpath_hash, 'Tie::IxHash';
if ( $realPath=~ m/$comparedPath$/)
{
print "$comparedPath exist";
}
else
{
print "$comparedPath is not exist";
#compared_array=split /\//,$comparedPath;
#realpath_array=split /\//,$realPath;
}
#compared_hash{#compared_array}=1;
#realpath_hash{#realpath_array}=1;
foreach my $key (keys %compared_hash)
{
delete $compared_hash{$key} if (grep {$_ =~/$key/} (keys %realpath_hash));
#leaving only unmatch Path Segment/Parse
}
print join("\n",%compared_hash);
Output:
classic

Answer 1

There's several ways they could compare.
They don't overlap at all.
They overlap, but one is too short.
They partially overlap.
They overlap perfectly.
Turn the paths into arrays using File::Spec->splitpath and splitdir. Then the problem becomes a matter of comparing arrays. It's also much simpler inside its own function because we can return as soon as we reach a conclusion.
First, we can use List::MoreUtils::after_incl to find the point where they start overlapping. In your example #remainder is qw(music retro perl.mp3).
my #remainder = after_incl { $_ eq $rel_path->[0] } #$abs_path;
if( !#remainder ) {
say "The paths do not overlap";
return;
}
Then we can walk #remainder and the path together to find where they diverge. And we also need to make sure we don't walk off the path.
for my $idx (1..$#remainder) {
if( $idx > $#$rel_path ) {
say "The path is too short";
return;
}
if( $remainder[$idx] ne $rel_path->[$idx] ) {
say "The paths differ at $remainder[$idx] vs $rel_path->[$idx]";
return;
}
}
Finally, if they match we need to check if there's more on the end of the path.
if( #$rel_path > #remainder ) {
say "The path is too long";
return;
}
And if it passes all that, they overlap.
say "The path is a child";
return;
Put it all together...
use strict;
use warnings;
use v5.10;
use List::MoreUtils qw(after_incl);
sub find_difference {
my($abs_path, $rel_path) = #_;
my #remainder = after_incl { $_ eq $rel_path->[0] } #$abs_path;
if( !#remainder ) {
say "The paths do not overlap";
return;
}
for my $idx (1..$#remainder) {
if( $remainder[$idx] ne $rel_path->[$idx] ) {
say "The paths differ at $remainder[$idx] vs $rel_path->[$idx]";
return;
}
}
if( #$rel_path > #remainder ) {
say "The path is too long";
return;
}
say "The path is a child";
return;
}
find_difference(
[qw(library media music retro perl.mp3)],
[qw(music retro perl.mp3 foo bar)]
);