Как определить несоответствие сегмента / парсинга между двумя путями Perl

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