Note: Please ignore the code listed here as it is buggy inside the while loop. Sorry for the noise.
First thing I thought of after reading OP was Algorithm::Permute module. (That led me to search for other permutations related modules. Now, I am more in favor of Math::Combinatorics and Algorithm::Combinatorics.)
I did not spend much time on thinking of a regex as that would have been hairy, though I liked BrowserUk's regex (which could get unwieldy if needs to be modified).
Below is the version which checks for overlapping strings ("abcXa" is ok, "abca" not). As it is, the program below uses &A::C::permutations. Feel free to exercise any of the other two modules. Basically, the big idea is ...
sub find_once
{
my ( $str , ... ) = @_ ;
...
my ( $pos , $once ) = ( 0 ) x2;
while ( my $p = get_permutation_string() )
{
last if $once > 1;
( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
}
return $once == 1;
}
Update: I just noticed that "once" specification is in the title, but missing from the body.
#!/usr/local/bin/perl
use warnings; use strict;
use Algorithm::Permute;
use Algorithm::Combinatorics qw/ permutations /;
use Math::Combinatorics;
my @in =
qw(
abc
cab
bac
acba
acbac
acbacb
acbXa
acbXac
acbXacb
acbaXc
acbaXcb
acbacXb
acbacbX
) ;
my @need = qw( a b c );
printf "%10s ok? %s\n"
, "'$_'"
# Feel free to switch to any other function.
, !!find_once_AC( $_ , @need ) ? 'yes' : 'no'
for @in ;
exit;
# Using Algorithm::Permute.
sub find_once_AP
{
my ( $str , @char ) = @_;
my $permute = Algorithm::Permute->new( [ @char ] );
my ( $pos , $once ) = ( 0 ) x 2;
while ( my $p = join '' , $permute->next )
{
last if $once > 1;
( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
}
return $once == 1;
}
# Using Math::Combinatorics.
sub find_once_MC
{
my ( $str , @char ) = @_;
my $permute = Math::Combinatorics->new( 'data' => [ @char ] );
my ( $pos , $once ) = ( 0 ) x 2;
while ( my $p = join '' , $permute->next_permutation )
{
last if $once > 1;
( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
}
return $once == 1;
}
# Using Algorithm::Combinatorics.
sub find_once_AC
{
my ( $str , @char ) = @_;
my $permute = permutations( [ @char ] );
my ( $pos , $once ) = ( 0 ) x 2;
while ( my $p = $permute->next )
{
$p = join '' , @{ $p };
last if $once > 1;
( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
}
return $once == 1;
}