use String::LCSS_XS qw( lcss ); sub lcssw { my ($s1, $s2) = @_; my $i; my %codes; my %words; for ($s1, $s2) { $_ = join '', map { $codes{$_} = chr(++$i) if !exists($codes{$_}); $codes{$_} } lc($_) =~ /\w+/g; } my $lcss = lcss($s1, $s2); @words{values %codes} = keys %codes; return join ' ', @words{ $lcss =~ /./sg }; }