Question

我有2条路径需要比较，如果不匹配，我想指出哪个子路径或不匹配的路径。有什么更好的方法吗？这仅适用于2条路径，我有很多路径需要比较。

#!/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);

输出：

classic

Answer 1

有几种比较方法。

它们根本不重叠。
它们重叠，但是一个太短了。
它们部分重叠。
它们完全重叠。

使用File::Spec->splitpath and splitdir将路径转换为数组。然后问题就变成了比较数组的问题。它在内部函数中也更简单，因为只要得出结论，我们就可以return。

首先，我们可以使用List::MoreUtils::after_incl查找它们开始重叠的点。在您的示例中，@remainder是qw(music retro perl.mp3)。

my @remainder = after_incl { $_ eq $rel_path->[0] } @$abs_path;
if( !@remainder ) {
    say "The paths do not overlap";
    return;
}

然后，我们可以一起走@remainder和一条小路，找出它们分开的地方。而且我们还需要确保我们不会走这条路。

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;
    }
}

最后，如果它们匹配，我们需要检查路径末尾是否还有其他内容。

if( @$rel_path > @remainder ) {
    say "The path is too long";
    return;
}

如果所有这些都通过，它们就会重叠。

say "The path is a child";
return;

将它们放在一起...

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)]
);

如何在两个路径之间精确定位不匹配的段/解析Perl

1 个答案: