while($text=~/\b(\w+)\b(?=.*\b\1\b)/g){ $words{$1} //= 1; # initialize empty value to one $words{$1}++; } #### use strict; use warnings; use 5.10.0; my %reps; my $text = "and him him lad has him done and john has has"; while($text =~ /\b(\w+)\b(?=.*\b\1\b)/g){ $reps{$1} //= 1; $reps{$1}++; } foreach my $key (keys %words){ say "$key: $reps{$key}"; }