use strict;
use Lingua::LinkParser;
## Demonstrates the creation of a regular expression to match linkages
## within a sentence linkage string. Give it "Perl rocks!" as input.
my $parser = new Lingua::LinkParser;
$parser->opts('disjunct_cost' => 2);
$parser->opts('linkage_limit' => 101);
while (1)
{
print "Enter a sentence about somethig that 'rocks'> ";
my $input = <STDIN>;
last if $input =~ /^\s*$/;
my $sentence = $parser->create_sentence($input);
my $linkage = $sentence->linkage(1);
# computing the union and then using the last sublinkage
# permits conjunctions.
$linkage->compute_union;
my $sublinkage = $linkage->sublinkage($linkage->num_sublinkages);
my $what_rocks = 'S[s|p]' . # match the link label
'(?:[\w\*]{1,2})*'.# match any optional subscripts
'\:(\d+)\:' . # match number of the word
'(\w+(?:\.\w)*)'; # match and save the word itself
my $other_stuff = '[^\)]+'; # match other stuff within parenthesis
my $rocks = '\"(rock[s|ed]*).v\"'; # match and store verb
# Fixed from printed code in TPJ #19.
my $no_objects = '(?![^\)]* O.{1,3}:)'; # don't match objects
my $pattern = "$what_rocks $other_stuff $rocks $no_objects";
if ( $sublinkage =~ /$pattern/mx )
{
my $wordobj = $sublinkage->word($1);
my $wordtxt = $2;
my $verb = $3;
my @wordlist = ();
foreach my $link ($wordobj->links)
{
# proper nouns and noun modifiers
if ($link->linklabel =~ /^G|AN|A/)
{
$wordlist[$link->linkposition] = $link->linkword;
}
# possessive pronouns, via a noun determiner
if ($link->linklabel =~ /^D[s|m]/)
{
my $wword = $sublinkage->word($link->linkposition);
foreach my $llink ($wword->links)
{
if ($llink->linklabel =~ /^YS/)
{
$wordlist[$llink->linkposition] = $llink->linkword;
$wordlist[$link->linkposition] = $link->linkword;
my $wwword = $sublinkage->word($llink->linkposition);
foreach my $lllink ($wwword->links)
{
if ($lllink->linklabel =~ /^G|AN/)
{
$wordlist[$lllink->linkposition] = $lllink->linkword;
}
}
}
}
}
}
print " -> ", join (" ", @wordlist, $wordtxt), "\n";
}
}