my $text_orig = "The respondent uses the following products XXX, YYYYYYYYY, ZZZZZZZ around the house and they are considering using QQQQQQQ too. They are particularly impressed with ZZZZZZZ.\n";

my @products = (
   'AAA',
   'BBBBBB',
   'CCCCCC',
   'DDDDDDDD',
   'QQQQQQQ',
   'XXX',      
   'YYYYYYYYY',
   'ZZZZZZZ',
);


for (1..4) {
   my @pot;

   (my $text_new = $text_orig) =~ s/[A-Z]{3,}/
      @pot = @products if not @pot;
      my $pot_idx = int(rand(@pot));
      splice(@pot, $pot_idx, 1)
   /eg;

   print($text_new);
}

##</code><code>##

use List::Util qw( shuffle );

my @pot;

for (1..4) {
   (my $text_new = $text_orig) =~ s/[A-Z]{3,}/
      @pot = shuffle @products if not @pot;
      pop(@pot)
   /eg;

   print($text_new);
}

##</code><code>##

for (1..4) {
   my %picked;

   (my $text_new = $text_orig) =~ s/[A-Z]{3,}/
      # We need more @products or a better algorithm if this executes.
      undef %picked if keys(%picked) > int(@products/2);

      my $pick;
      do { $pick = int(rand(@products)); } while not $picked{$pick};
      $picked{$pick} = 1;
      $products[$pick]
   /eg;

   print($text_new);
}

##</code><code>##

use Benchmark qw( cmpthese );

my %a = map { $_ => 1 } 1..10;
my %b = map { $_ => 1 } 1..100;
my %c = map { $_ => 1 } 1..10000;

cmpthese(-1, {
   a => sub { keys(%a) == 1; },
   b => sub { keys(%b) == 1; },
   c => sub { keys(%c) == 1; },
});

##</code><code>##

       Rate   a   c   b
a 2314690/s  -- -1% -5%
c 2340571/s  1%  -- -4%
b 2429401/s  5%  4%  --