Regex matching characters of one string in another in any order

Here is a pure regex: do a positive lookahead for each character

use warnings;
use strict;
use feature 'say';
use List::Util qw(uniq);  # before v. 1.45 in List::MoreUtils    

my $string = shift // q(wizard);

my $patt = join '', map { qq{(?=.*\Q$_\E)} } uniq split //, $string; 
# say $patt;  
#--> (?=.*w)(?=.*i)(?=.*z)(?=.*a)(?=.*r)(?=.*d)   (for wizard)

while (<DATA>) {
    say "Found '$string' in: $_" if /^$patt/is;
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

Being all in one regex, with an anchored lookahead and no overhead, this should be very fast.

The \Q...\E are there in case the search string contains regex-sensitive characters.

This code considers words with repeated characters (latte, rare) to "fit" a word without that (later). It is clarified in comments that this is indeed the wanted behavior: repeated characters need only be found once in the target (letter matches later etc).

The following should be quite fast (especially if you inline the subs):

use feature qw( fc say );

sub make_key {
   my %counts;
   ++$counts{$_} for split //, fc($_[0]) =~ s/\PL//rg;
   return \%counts;
}

sub search {
   my ($substr, $str) = @_;
   $str = make_key($str);
   no warnings qw( uninitialized );
   return !( grep { $str->{$_} < $substr->{$_} } keys(%$substr) );
}

my $substr = make_key("wizard");
while (<>) {
   chomp;
   say search($substr, $_) ? 0 : 1;
}

Unlike virtually all of the previous solutions, this one doesn't consider latte to be in late.

The following is a regex based solution (with some prep). This should also be quite fast (especially if you inline the subs).

use feature qw( fc say );

sub make_re {
   my $pat = join ".*?", map quotemeta, sort split //, fc($_[0]) =~ s/\PL//rg;
   return qr/$pat/s;
}

sub search {
   my ($substr, $str) = @_;
   return ( join "", sort split //, $str ) =~ $substr;
}

my $substr = make_re("wizard");   # qr/a.*?d.*?i.*?r.*?w.*?z/is
while (<>) {
   chomp;
   say search($substr, $_) ? 0 : 1;
}

Finally, a purely regexp-based solution.

use feature qw( fc say );

sub make_re {
   my %counts;
   ++$counts{$_} for split //, fc($_[0]) =~ s/\PL//rg;
   my $pat =
      join "",   
         map { "(?=".( ( ".*?" . quotemeta($_) ) x $counts{$_} ).")" }
            #sort
               keys(%counts);
   return qr/^$pat/s;
}

my $re = make_re("wizard");  # qr/^(?=.*?a)(?=.*?d)(?=.*?i)(?=.*?r)(?=.*?w)(?=.*?z)/is
while (<>) {
   say /$re/ ? 0 : 1;
}

Unlike virtually all of the previous solutions, none of mine consider latte to be in late.

It's just a simple matter of using a positive lookahead for every character.

my @stars = (
  'Garry Kasparov',
  'Bobby Fischer',
  'Vladimir Kramnik',
  'Wayne Drimaz',
  'Lionel Messi',
  'La Signora'
);

say /^(?=.*w)(?=.*i)(?=.*z)(?=.*a)(?=.*r)(?=.*d)/i ? 0 : 1 for @stars;

This outputs 111011.

I find canonicalization of the inputs and the pattern to be a more generalizable and understandable approach:

#!/usr/bin/env perl

use strict;
use warnings;

sub canonchars {
    my %c;
    $c{$_} = undef for map lc, grep /\S/, split //, $_[0];
    sort keys %c;
}

sub pattern {
    map "$_.*", canonchars($_[0]);
}

my %canonical;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;
    push $canonical{join '', canonchars($line)}->@*, $line;
}

my $pat = qr/@{[join '', pattern('wizard')]}/;

for my $k (keys %canonical) {
    if ($k =~ $pat) {
        print for $canonical{$k}->@*;
    }
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

Output:

C:\Temp> perl t.pl
Wayne Drimaz

There is a lot of logic you are trying to fit into a regular expression pattern, and every edge case you find and fix will make it more complicated and more fragile.

No need for regular expressions... they just complicate things, especially if you're not looking for a string you know ahead of time. Just look for each character in turn after normalizing their cases.

#!/usr/bin/env perl
use strict;
use warnings;

sub contains_chars {
    my ($needle, $haystack) = @_;
    $haystack = lc $haystack;
    my %positions;
    for my $char (split //, lc $needle) {
        my $p = index $haystack, $char, $positions{$char}//0;
        return 1 if $p < 0;
        $positions{$char} = $p + 1;
    }
    return 0;
}

while (<DATA>) {
    print contains_chars("wIzArD", $_);
}
print "\n";

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

This a black art way that out of order matching can occur.
Each character in the source string is visited only once.
No need to recurse the string from the beginning for each letter.

use strict;
use warnings;

while (my $line = <DATA>) {
   if ( $line =~ /
     (?:
       .*?
       (?:
           (?(1)(?!))(w)
         | (?(2)(?!))(i)
         | (?(3)(?!))(z)
         | (?(4)(?!))(a)
         | (?(5)(?!))(r)
         | (?(6)(?!))(d)
       )
     ){6}/ix ) { print $line, "\n" }
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

Wayne Drimaz

Captures can exist in two states, defined or undefined.
The essence of this black art is to use the state of captures as flags
to insure all the items are matched in the out-of-order state.

The above can also be written this way with the same result.

use strict;
use warnings;

while (my $line = <DATA>) {
   if ( $line =~ /
     (?im)
     ^ 
     (?>
        .*? 
        (?:
           w ( )       # (1)
         | i ( )       # (2)
         | z ( )       # (3)
         | a ( )       # (4)
         | r ( )       # (5)
         | d ( )       # (6)
        )
     )+
     (?= \1 \2 \3 \4 \5 \6 )
   /x ) { print $line, "\n" }
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

Just adding a simple variant of /w/ && /i/ && /z/ ... solution I mentioned in comments. If you want this solution to match a lot of different strings, instead of lining the regexes together with &&, you can simply loop over the characters. A useful tool is to use the &&= operator to mimic the behaviour of a long string of conditions. This will also allow us to short-circuit the matching if we find a mismatch, giving us a speed benefit.

For example:

/a/ && /b/ && /c/

Equivalent to

my $match = 1;
for my $w (qw(a b c)) {
    $match &&= (/$w/);    # $match = ($match && /$w/)
}

To remember the count of letters, i.e. whether latte should be considered to be a substring of late, you can simply use the substitution operator s/// instead of match operator m//. I added the multi-letter criteria, and added two test cases to demonstrate.

I like this solution because of the simplicity, but thereby not said it is the best one.

use strict;
use warnings;

my $word = "wizzard";

while (<DATA>) {
    print search($_, $word), " $_";
}

sub search {
    my ($str, $substr) = @_;
    my $match = 1;                        # assume true
    for my $w (split //, $substr) {       # for each char in substr...
        $match &&= ($str =~ s/\Q$w//i);   # ...remove character
        return 0 if not $match;           # ...return false if no match found
    }
    return 1 if $match;
}

__DATA__
wizard
wizzard
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Wayne Drimazz
Lionel Messi
La Signora

Output:

0 wizard
1 wizzard
0 Garry Kasparov
0 Bobby Fischer
0 Vladimir Kramnik
0 Wayne Drimaz
1 Wayne Drimazz
0 Lionel Messi
0 La Signora

If you do not care about multi-letter matching, just replace s/// with m//.