Re: Replacing substrings with links

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;
[download]

-*- 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
[download]

Cheers Rolf
_{(addicted to the Perl Programming Language :)

Wikisyntax for the Monastery}

Comment on Re: Replacing substrings with links Select or Download Code

Replies are listed 'Best First'.
Re^2: Replacing substrings with links by choroba (Cardinal) on Feb 05, 2022 at 20:40 UTC
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; }` [download] `map{substr$_->[0],$_->[1]\|\|0,1}[\\|\|{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^ARGV,3]`	[reply] [d/l] [select]
Re^3: Replacing substrings with links by LanX (Saint) on Feb 06, 2022 at 14:59 UTC
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; }` [download] 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;` [download] `-- 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` [download] Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery}	[reply] [d/l] [select]
Re^4: Replacing substrings with links by choroba (Cardinal) on Feb 06, 2022 at 17:20 UTC
I tested my previous code with `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/SUSE' => '/usr/bin', '/a/b/c' => '/p', '/p/dt' => '/nfs/us'};` [download] Your code gives the same result for the input. Update: Ordering is important. I have no idea what the expected output of `my $h_orig = { '/a' => '/b/c', '/b/c' => '/a', };` [download] is. `map{substr$_->[0],$_->[1]\|\|0,1}[\\|\|{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^ARGV,3]`	[reply] [d/l] [select]
Re^5: Replacing substrings with links (updated) by LanX (Saint) on Feb 06, 2022 at 17:23 UTC
Re^3: Replacing substrings with links by LanX (Saint) on Feb 05, 2022 at 20:46 UTC
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}	[reply]


Syntactic Confectionery Delight
	PerlMonks