Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Replacing substrings with links

by ovedpo15 (Pilgrim)
on Feb 05, 2022 at 19:52 UTC ( [id://11141154]=perlquestion: print w/replies, xml ) Need Help??

ovedpo15 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks!
I have the following hash ref:
{ '/a/b/c/dt/data/SUSE/tool/0.9.0' => '/a/b/c/dt/tools/SUSE/tool/0.9.0 +', '/nfs/us/tools/SUSE12' => '/usr/bin', '/a/b/c' => '/p' };
Each key is a path, which is the absolute path of the value. For example:
realpath /p # Yields /a/b/c
For each value, I would like to replace the substring with the other link, if such exists. In our case, we have '/a/b/c/dt/sde/tools/em64t_SUSE/tool/0.9.0' and '/a/b/c' => '/p', so I would like to have:
{ '/a/b/c/dt/data/SUSE/tool/0.9.0' => '/p/dt/tools/SUSE/tool/0.9.0', '/nfs/us/tools/SUSE12' => '/usr/bin', '/a/b/c' => '/p' };
I thought about doing the following - do two foreach loops on the keys (one nested inside the other). In the second loop, I would ignore the case where the two keys are the same. Then I would compare the values (if it starts with the value, then replace it). The current code that I code:
foreach my $actual_path_to_check (keys(%{$virtual_paths_href})) { foreach my $current_actual_path (keys(%{$virtual_paths_href})) { next if ($actual_path_to_check eq $current_actual_path); if ($virtual_paths_href->{$current_actual_path} =~ /^$virtual_ +paths_href->{$actual_path_to_check}/) { # Replace } } }
But then I figured that I don't know how many loops I would need. For example, if I have a case of a link which points to another link (like /x -> /y -> /z). In that case, I would need another loop over the values. The goal is to replace the substrings parts with the other links of other keys (not depending of the environment). How it can be done?

Replies are listed 'Best First'.
Re: Replacing substrings with links
by LanX (Saint) on Feb 05, 2022 at 22:10 UTC
    > Each key is a path, which is the absolute path of the value. For example:

    > realpath /p # Yields /a/b/c

    > For each value, I would like to replace the substring with the other link, if such exists. In our case, we have "/a/b/c/dt/sde/tools/em64t_SUSE/tool/0.9.0" and "/a/b/c" => "/p" , so I would like to have:

    You are aware that a file system can have multiple links pointing to the same "realpath", right?

    And if you had multiple links qualifying like an additional "/a/b" => "/q" you'd probably want to replace "/a/b/c" first to have a shorter result.

    This will become pretty messy without further clarification.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

Re: Replacing substrings with links
by LanX (Saint) on Feb 05, 2022 at 20:30 UTC
    This does a part of the job except

    > I would ignore the case where the two keys are the same.

    ... because I doubt this will lead to any predictable results anyway (sorting matters).

    use strict; use warnings; use Data::Dump qw/pp dd/; my $h_orig = { '/a/b/c/dt/data/SUSE/tool/0.9.0' => '/a/b/c/dt/tools/SUSE/tool/0.9.0 +', '/nfs/us/tools/SUSE12' => '/usr/bin', '/a/b/c' => '/p' }; my $pattern = join "|", map quotemeta, keys %$h_orig; my %copy = %$h_orig; s/^($pattern)/$h_orig->{$1}/g for values %copy; pp $h_orig, \%copy;

    -*- mode: compilation; default-directory: "d:/tmp/pm/" -*- Compilation started at Sat Feb 5 21:29:56 C:/Strawberry/perl/bin\perl.exe -w d:/tmp/pm/replace_patl.pl ( { "/a/b/c" => "/p", "/a/b/c/dt/data/SUSE/tool/0.9.0" => "/a/b/c/dt/tools/SUSE/tool/0.9 +.0", "/nfs/us/tools/SUSE12" => "/usr/bin", }, { "/a/b/c" => "/p", "/a/b/c/dt/data/SUSE/tool/0.9.0" => "/p/dt/tools/SUSE/tool/0.9.0", "/nfs/us/tools/SUSE12" => "/usr/bin", }, ) Compilation finished at Sat Feb 5 21:29:57

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

      If more than one iteration is needed, you can use a loop with a "change" flag:
      my $change = 1; while ($change) { $change = 0; $change ||= s/^($pattern)/$h_orig->{$1}/g for values %copy; }

      map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
        I think it's easier and more efficient to switch the loops.

        for (values %copy) { 1 while # repeat till no replacement +left s/^($pattern)/$h_orig->{$1}/g; }

        But I have trouble to come up with a test case covering the complicated implications. ( Update Anyone? )

        use strict; use warnings; use Data::Dump qw/pp dd/; my $h_orig = { '/a/b/c/dt/data/SUSE/tool/0.9.0' => '/a/b/c/dt/tools/SUSE/tool/0.9.0 +', '/nfs/us' => '/usr/bin', '/a/b/c' => '/nfs/us' }; my $pattern = join "|", map quotemeta, keys %$h_orig; my %copy = %$h_orig; for (values %copy) { 1 while s/^($pattern)/$h_orig->{$1}/g; } pp $h_orig, \%copy;

        -*- mode: compilation; default-directory: "d:/tmp/pm/" -*- Compilation started at Sun Feb 6 15:59:06 C:/Strawberry/perl/bin\perl.exe -w d:/tmp/pm/replace_pat2.pl ( { "/a/b/c" => "/nfs/us", "/a/b/c/dt/data/SUSE/tool/0.9.0" => "/a/b/c/dt/tools/SUSE/tool/0.9 +.0", "/nfs/us" => "/usr/bin", }, { "/a/b/c" => "/usr/bin", "/a/b/c/dt/data/SUSE/tool/0.9.0" => "/usr/bin/dt/tools/SUSE/tool/0 +.9.0", "/nfs/us" => "/usr/bin", }, ) Compilation finished at Sun Feb 6 15:59:06

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

        I really have a problem with the whole fuzzy concept, otherwise I would try to work with sorting first.

        Now apparently there are values which include their own key, otherwise this exclusion criteria wouldn't be needed.

        But what kind of sane link is self referential?

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11141154]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-03-29 04:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found