How to obtain the captured groups in perl - regex

Question

I'm currently working on a simple script to detect the relations between people. I define the $np to be the regex of a Proper Noun.
In my first task, the goal is to find all the proper nouns that appear left of another proper noun in which the number of words between them is less than a fixed value. I have written the following code:
$/ = '';
my $PM = qr{\b[A-Z][\w-]*\w};
my $de = qr{d[aoe]s?};
my $s = qr{[\n ]};
my $np = qr{$PM (?: $s $PM | $s $de $s $PM )*}x;
while(<>){
while(/($np)/g){
print("$1 : ");
my #x = m/(?=(?: $s+ (?: [\w-]+ | ($np)) ){1,7})/gx;
my $y = join(", ", #x);
print("$y\n");
}
}
I expected it to print all the proper nouns in the file and, for each one of them, the proper nouns that are in the window. However, this is not happening.
How can I make it work like I want?
PS: I'm a perl newbie
EDIT: Some people recommended to add samples of input and output expected.
If I had a file with the following text
John asked Mary to meet Anna.
then, I would like my script to print
John : Mary, Anna
Mary : Anna
Anna :
However, in its current state, I get commas printed in an infinite loop.

Answer 1

You get an infinite loop because the position of match for $_ is changed again after you do the second match. You can assign it to a named variable before the match to avoid this:
while( <> ) {
my $line = $_;
while( $line =~/($np)/g ) {
...
}
}
See Using regular expressions in Perl and pos() for details.

Answer 2

Is it a requirement to use regex? Doesn't seem to be the best way to me.
I'd just split the string into words and go through that. Something like the code below.
Not sure I understand correctly your specification. What my code does is to find proper names that appear within certain distance to the left of other proper name.
my $window = 3;
my %result;
while(<DATA>){
my #words = map {$_ =~ s/[[:punct:]]$//; $_} split;
my $index = $#words;
for (my $index = $#words; $index > 0; $index--) {
my $word = $words[$index];
next unless is_name($word);
my $start_index = $index - 3;
$start_index = 0 if $start_index < 0;
my $end_index = $index - 1;
$end_index = 0 if $end_index < 0;
my #neigbours = grep {is_name($_)} #words[$start_index .. $end_index];
$result{$word} = [#neigbours] if #neigbours;
}
}
sub is_name {
shift =~ /^[A-Z][\w-]*\w$/;
}
__DATA__
John asked Mary to meet Anna.